From 66726a21f846126b19082445cb7b7b1603bc1749 Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Sun, 7 Mar 2021 11:28:36 -0500
Subject: [PATCH] Implement 4.76

---
 ex-4_70-79.scm | 65 ++++++++++++++++++++++++++++++++++----------------
 1 file changed, 44 insertions(+), 21 deletions(-)

diff --git a/ex-4_70-79.scm b/ex-4_70-79.scm
index eff6dff..854e4ae 100644
--- a/ex-4_70-79.scm
+++ b/ex-4_70-79.scm
@@ -108,7 +108,7 @@
     (lambda (x1) (stream-map (lambda (x2) (append x1 x2)) s2))
     s1))
 
-(define (conjoin conjuncts frame-stream)
+(define (conjoin-efficient conjuncts frame-stream)
   (define (unify-bindings bindings)
     (define (go-unify bindings frame)
       (if (null? bindings)
@@ -120,42 +120,65 @@
     (go-unify bindings '()))
 
   (define (unify-frame-streams frame-stream-1 frame-stream-2)
-    (display "UNIFY-FRAME-STREAMS\n")
     (let ((potential-bindings (stream-combinations frame-stream-1 frame-stream-2)))
       (stream-filter
         (lambda (f) (not (eq? f 'failed)))
         (stream-map unify-bindings potential-bindings))))
 
-  (define (unify-frame-stream-list frame-stream-list)
-    (if (null? (cdr frame-stream-list))
-      (car frame-stream-list)
-      (let ((frame-stream (unify-frame-streams (car frame-stream-list)
-                                               (cadr frame-stream-list))))
-        (display frame-stream) (newline)
-        (unify-frame-stream-list (cons frame-stream (cddr frame-stream-list))))))
+  (define (conjoin-single conjunct frame-stream-1)
+    (if (not (tagged-list? conjunct 'not))
+      (unify-frame-streams
+        frame-stream-1
+        (qeval conjunct frame-stream)) ; process separately
+      (qeval conjunct frame-stream-1))) ; cannot process not separately
 
-  (define (qeval-conjunction conjunction)
-    (qeval conjunction frame-stream))
+  (define (conjoin-inner conjuncts frame-stream)
+    (if (null? conjuncts)
+      frame-stream
+      (let ((new-frame-stream (conjoin-single (car conjuncts) frame-stream)))
+        (conjoin-inner (cdr conjuncts) new-frame-stream))))
 
-  (let ((frame-stream-list (map qeval-conjunction conjuncts)))
-    (unify-frame-stream-list frame-stream-list)))
+  (conjoin-inner conjuncts frame-stream))
 
-(put 'and 'qeval conjoin)
+(put 'and2 'qeval conjoin-efficient)
 
 (eval-query
   '(rule (big-shot ?p)
-    (and (job ?p (?div1 . ?rest1))
-         (supervisor ?p ?boss)
-         (job ?boss (?div2 . ?rest2))
-         (not (same ?div1 ?div2)))))
+    (and2 (job ?p (?div1 . ?rest1))
+          (supervisor ?p ?boss)
+          (job ?boss (?div2 . ?rest2))
+          (not (same ?div1 ?div2)))))
 
 (eval-query '(big-shot ?x))
 (newline)
 
+(display "\nex-4.77 - improved-not\n")
+
+; Exercise 4.77.  In section 4.4.3 we saw that not and lisp-value can cause the
+; query language to give ``wrong'' answers if these filtering operations are
+; applied to frames in which variables are unbound. Devise a way to fix this
+; shortcoming.
+
+; One idea is to perform the filtering in a ``delayed'' manner by
+; appending to the frame a ``promise'' to filter that is fulfilled only when
+; enough variables have been bound to make the operation possible. We could
+; wait to perform filtering until all other operations have been performed.
+; However, for efficiency's sake, we would like to perform filtering as soon as
+; possible so as to cut down on the number of intermediate frames generated.
+
+(display "--")
 (eval-query
+  '(and (supervisor ?x ?y)
+        (not (job ?x (computer programmer)))))
+(display "\n--\n")
 
-(display "\nex-4.77\n")
+(display "--")
+(eval-query
+  '(and (not (job ?x (computer programmer)))
+        (supervisor ?x ?y)))
+(display "\n--\n")
 
-;(display "\nex-4.78\n")
-;(display "\nex-4.79\n")
+(display "\nex-4.78\n")
+
+(display "\nex-4.79\n")