changes needed to turn the analyzing interpreter of SICP 4.1 to the nondeterministic interpreter of SICP 4.3

analyzing->nondeterministic.diff

diff --git a/nondeterministic.scm b/nondeterministic.scm
index 1fab899..52e5b73 100644
--- a/nondeterministic.scm
+++ b/nondeterministic.scm
@@ -1,5 +1,5 @@
-(define (eval exp env)
-  ((analyze exp) env))
+(define (eval exp env succeed fail)
+  ((analyze exp) env succeed fail))
 
 (define (analyze exp)
   (cond ((self-evaluating? exp) (analyze-self-evaluating exp))
@@ -11,21 +11,25 @@
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence exp))
         ((cond? exp) (analyze (cond->if exp)))
+        ((amb? exp) (analyze-amb exp))
         ((application? exp) (analyze-application exp))
         (else
           (error "Unknown expression type -- ANALYZE" exp))))
 
 (define apply-in-underlying-scheme apply) ;; need it later for primitives
 
-(define (execute-application procedure arguments)
+(define (execute-application procedure arguments succeed fail)
   (cond ((primitive-procedure? procedure)
-         (apply-primitive-procedure procedure
-                                    arguments))
+         (succeed (apply-primitive-procedure procedure
+                                    arguments)
+                  fail))
         ((compound-procedure? procedure)
          ((procedure-body procedure)
           (extend-environment (procedure-parameters procedure)
                               arguments
-                              (procedure-environment procedure))))
+                              (procedure-environment procedure))
+          succeed
+          fail))
         (else
           (error "Unknown procedure type -- EXECUTE-APPLICATION" procedure))))
 
@@ -109,6 +113,9 @@
                  (sequence->exp (cond-actions first))
                  (expand-clauses rest))))))
 
+(define (amb? exp) (tagged-list? exp 'amb))
+(define (amb-choices exp) (cdr exp))
+
 (define (application? exp) (pair? exp))
 (define (operator exp) (car exp))
 (define (operands exp) (cdr exp))
@@ -131,53 +138,76 @@
 ;; eval helpers
 
 (define (analyze-self-evaluating exp)
-  (lambda (env) exp))
+  (lambda (env succeed fail)
+    (succeed exp fail)))
 
 (define (analyze-quoted exp)
   (let ((qval (text-of-quotation exp)))
-    (lambda (env) qval)))
+    (lambda (env succeed fail)
+      (succeed qval fail))))
 
 (define (analyze-variable exp)
-  (lambda (env) (lookup-variable-value exp env)))
+  (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail)))
 
 (define (analyze-assignment exp) 
   (let ((var (assignment-variable exp))
         (vproc (analyze (assignment-value exp))))
-    (lambda (env)
-      (set-variable-value! var
-                           (vproc env)
-                           env)
-      'ok)))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)
+               (let ((old-val (lookup-variable-value var env)))
+                 (set-variable-value! var
+                                      val
+                                      env)
+                 (succeed 'ok
+                          (lambda ()
+                            (set-variable-value! var
+                                                 old-val
+                                                 env)
+                            (fail2)))))
+             fail))))
 
 (define (analyze-definition exp)
   (let ((var (definition-variable exp))
         (vproc (analyze (definition-value exp))))
-    (lambda (env)
-      (define-variable! var
-                        (vproc env)
-                        env)
-      'ok)))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)
+               (define-variable! var
+                                 val
+                                 env)
+               (succeed 'ok fail2))
+             fail))))
 
 (define (analyze-if exp)
   (let ((pproc (analyze (if-predicate exp)))
         (cproc (analyze (if-consequent exp)))
         (aproc (analyze (if-alternative exp))))
-    (lambda (env)
-      (if (pproc env)
-        (cproc env)
-        (aproc env)))))
+    (lambda (env succeed fail)
+      (pproc env
+             ;; success continuation for predicate eval
+             (lambda (pred-value fail2)
+               (if pred-value
+                 (cproc env succeed fail2)
+                 (aproc env succeed fail2)))
+             fail))))
 
 (define (analyze-lambda exp)
   (let ((vars (lambda-parameters exp))
         (bproc (analyze-sequence (lambda-body exp))))
-    (lambda (env)
-      (make-procedure vars
-                      bproc
-                      env))))
+    (lambda (env succeed fail)
+      (succeed (make-procedure vars
+                               bproc
+                               env)
+               fail))))
 
 (define (analyze-sequence exps)
   (define (sequentially proc1 proc2)
-    (lambda (env) (proc1 env) (proc2 env)))
+    (lambda (env succeed fail)
+      (proc1 env
+             (lambda (proc1-value fail2)
+               (proc2 env succeed fail2))
+             fail)))
   (define (loop first-proc rest-procs)
     (if (null? rest-procs)
       first-proc
@@ -188,13 +218,47 @@
       (error "Empty sequence -- ANALYZE"))
     (loop (car procs) (cdr procs))))
 
+(define (analyze-amb exp)
+  (let ((cprocs (map analyze (amb-choices exp))))
+    (lambda (env succeed fail)
+      (define (try-next choices)
+        (if (null? choices)
+          (fail)
+          ((car choices) env
+                         succeed
+                         (lambda ()
+                           (try-next (cdr choices))))))
+      (try-next cprocs))))
+
 (define (analyze-application exp)
   (let ((fproc (analyze (operator exp)))
         (aprocs (map analyze (operands exp))))
-    (lambda (env)
-      (execute-application (fproc env)
-                           (map (lambda (aproc) (aproc env))
-                                aprocs)))))
+    (lambda (env succeed fail)
+      (fproc env
+             (lambda (proc fail2)
+               (get-args aprocs
+                         env
+                         (lambda (args fail3)
+                           (execute-application proc
+                                                args
+                                                succeed
+                                                fail3))
+                         fail2))
+             fail))))
+
+(define (get-args aprocs env succeed fail)
+  (if (null? aprocs)
+    (succeed '() fail)
+    ((car aprocs) env
+                  (lambda (arg fail2)
+                    (get-args (cdr aprocs)
+                              env
+                              (lambda (args fail3)
+                                (succeed (cons arg args)
+                                         fail3))
+                              fail2))
+                  fail)))
+
 
 ;;; nested environments
 
@@ -279,6 +343,7 @@
     (list 'cdr cdr)
     (list 'cons cons)
     (list 'null? null?)
+    (list 'not not)
     (list '+ +)
     (list '- -)
     (list '* *)
@@ -302,8 +367,8 @@
 ;;; REPL
 
 (define the-global-environment (setup-environment))
-(define input-prompt ";;; A-Eval input")
-(define output-prompt ";;; A-Eval output")
+(define input-prompt ";;; Amb-Eval input")
+(define output-prompt ";;; Amb-Eval output")
 
 (define (prompt-for-input string)
   (newline)
@@ -325,11 +390,45 @@
     (display object)))
 
 (define (driver-loop)
-  (prompt-for-input input-prompt)
-  (let ((input (read)))
-    (let ((output (eval input the-global-environment)))
-      (announce-output output-prompt)
-      (user-print output)))
-  (driver-loop))
+  (define (internal-loop try-again)
+    (prompt-for-input input-prompt)
+    (let ((input (read)))
+      (if (eq? input 'try-again)
+        (try-again)
+        (begin
+          (newline)
+          (display ";;; starting a new problem ")
+          (eval input
+                the-global-environment
+                ;; success continuation
+                (lambda (output next-alternative)
+                  (announce-output output-prompt)
+                  (user-print output)
+                  (internal-loop next-alternative))
+                ;; failure continuation
+                (lambda ()
+                  (announce-output ";;; there are no more values of ")
+                  (user-print input)
+                  (driver-loop)))))))
+  (internal-loop
+    (lambda ()
+      (newline)
+      (display ";;; no current problem")
+      (driver-loop))))
+
+(eval '(define require
+          (lambda (p)
+                (if (not p) (amb))))
+      the-global-environment
+      (lambda (value fail) 'succeeded)
+      (lambda () 'failed))
+
+(eval '(define an-element-of
+          (lambda (items)
+                (require (not (null? items)))
+                    (amb (car items) (an-element-of (cdr items)))))
+      the-global-environment
+      (lambda (value fail) 'succeeded)
+      (lambda () 'failed))
 
 (driver-loop)