Finish implementation of query inside amb-evaluator

ex-4_78-79.scm

@@ -137,9 +137,15 @@
 ;;(put 'lisp-value 'qeval lisp-value)
 
 (define (execute exp)
-  (display "EXECUTE ") (display exp) (newline)
+  (let ((op (car exp)))
-  (apply (eval (predicate exp) user-initial-environment)
+    (cond
-         (args exp)))
+      ((eq? op '<) (< (cadr exp) (cadr (cdr exp))))
+      ((eq? op '>) (> (cadr exp) (cadr (cdr exp))))
+      (else
+        (display "list-value OP not supported ")
+        (display op)
+        (newline)
+        #f))))
 
 (define (always-true ignore frame-list) frame-list)
 
@@ -298,7 +304,7 @@
 (define (add-rule! rule)
   (store-rule-in-index rule)
   (let ((old-rules THE-RULES))
-    (set! THE-RULES (stream rule old-rules))
+    (set! THE-RULES (cons rule old-rules))
     'ok))
 
 (define (store-assertion-in-index assertion)
@@ -681,19 +687,30 @@
 
 (initialize-data-base microshaft-data-base)
 
+;; We are insided the non-deterministic evaluator here.
+
+(display "\nex-4.78 - non-deterministic-query\n")
+(display "[installed-query-system]\n")
+
+; Query is working within non-deterministic evaluator. Now we can switch to
+; amb.
+
+(eval-query
+  '(rule (big-shot ?p)
+    (and (job ?p (?div1 . ?rest1))
+         (supervisor ?p ?boss)
+         (job ?boss (?div2 . ?rest2))
+         (not (same ?div1 ?div2)))))
+
 (eval-query
   '(and (salary (Bitdiddle Ben) ?ben-amount)
         (salary ?person ?amount)
         (lisp-value > ?amount ?ben-amount)))
 
-(display "[done]\n")
+(eval-query '(big-shot ?x))
+(newline)
 ))
 
-(display "\nex-4.78 - non-deterministic-query\n")
-
-; I am trying to get the query evaluator working within the non-deterministic
-; evaluator. The next step is to implement analyze-or in the non-deterministic
-; evaluator.
-
 (display "\nex-4.79\n")
 
+

misc/sicp-ambeval.scm

@@ -329,8 +329,6 @@
   (apply-in-underlying-scheme
    (primitive-implementation proc) args))
 
-
-
 (define input-prompt ";;; M-Eval input:")
 (define output-prompt ";;; M-Eval value:")
 
@@ -394,7 +392,6 @@
         ((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))                ;**
@@ -406,12 +403,6 @@
         (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))
 
@@ -682,8 +673,10 @@
         (list 'abs abs)
         (list 'assoc assoc)
         (list 'append append)
+        (list 'caddr caddr)
         (list 'cadr cadr)
         (list 'car car)
+        (list 'cddr cddr)
         (list 'cdr cdr)
         (list 'cons cons)
         (list 'display display)