Contine to implement query within non-deterministc evaluator

misc/sicp-ambeval.scm

@@ -394,21 +394,27 @@
         ((if-fail? exp) (analyze-if-fail exp))
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence (begin-actions exp)))
+        ((apply? exp) (analyze-apply (cdr exp)))
         ((cond? exp) (analyze (cond->if exp)))
         ((let? exp) (analyze (let->combination exp))) ;**
         ((amb? exp) (analyze-amb exp))                ;**
         ((ramb? exp) (analyze-ramb exp))                ;**
         ((lamb? exp) (analyze-lamb exp))                ;**
-        ((or? exp) (analyze-or exp))
+        ((or? exp) (analyze-or (clauses exp)))
+        ((and? exp) (analyze-and (clauses exp)))
         ((application? exp) (analyze-application exp))
         (else
          (error "Unknown expression type -- ANALYZE" exp))))
 
+(define (apply? exp) (tagged-list? exp 'apply))
+(define (analyze-apply exp)
+  (display "ANALYZE-APPLY ") (newline)
+  (display exp)
+  (lambda (env succeed fail) (succeed #t fail)))
+
 (define (ambeval exp env succeed fail)
   ((analyze exp) env succeed fail))
 
-;;;Simple expressions
-
 (define (analyze-self-evaluating exp)
   (lambda (env succeed fail)
     (succeed exp fail)))
@@ -431,11 +437,39 @@
                fail))))
 
 (define (or? exp) (tagged-list? exp 'or))
+(define (and? exp) (tagged-list? exp 'and))
 (define (clauses exp) (cdr exp))
 (define (no-clauses? exp) (null? exp))
 (define (first-clause exp) (car exp))
 (define (rest-clauses exp) (cdr exp))
-; TODO: (define (analyze-or exp) ...)
+
+(define (analyze-or exp)
+  (if (no-clauses? exp)
+    (lambda (env succeed fail) (succeed #f fail))
+    (let ((cproc (analyze (first-clause exp))))
+      (lambda (env succeed fail)
+        (cproc
+          env
+          ;; success continuation for clause value
+          (lambda (clause-value fail2)
+            (if (true? clause-value)
+                (succeed #t fail2)
+                ((analyze-or (rest-clauses exp)) env succeed fail2)))
+               fail)))))
+
+(define (analyze-and exp)
+  (if (no-clauses? exp)
+    (lambda (env succeed fail) (succeed #t fail))
+    (let ((cproc (analyze (first-clause exp))))
+      (lambda (env succeed fail)
+        (cproc
+          env
+          ;; success continuation for clause value
+          (lambda (clause-value fail2)
+            (if (true? clause-value)
+                ((analyze-and (rest-clauses exp)) env succeed fail2)
+                (succeed #f fail2)))
+               fail)))))
 
 ;;;Conditionals and sequences
 (define (analyze-if exp)
@@ -647,10 +681,13 @@
         (list '>= >=)
         (list 'abs abs)
         (list 'assoc assoc)
+        (list 'append append)
+        (list 'cadr cadr)
         (list 'car car)
         (list 'cdr cdr)
         (list 'cons cons)
         (list 'display display)
+        (list 'equal? equal?)
         (list 'eq? eq?)
         (list 'integer? integer?)
         (list 'list list)
@@ -664,11 +701,12 @@
         (list 'set-car! set-car!)
         (list 'set-cdr! set-cdr!)
         (list 'sqrt sqrt)
+        (list 'string->symbol string->symbol)
+        (list 'string-length string-length)
         (list 'string=? string=?)
         (list 'substring substring)
         (list 'symbol->string symbol->string)
         (list 'symbol? symbol?)
-        (list 'the-empty-stream the-empty-stream)
         ))
 
 'AMB-EVALUATOR-LOADED