(load "util.scm")
(load "misc/sicp-query.scm")

(initialize-data-base microshaft-data-base)

(display "\nex-4.61 - next-to\n")

(eval-query '(append-to-form x y z))
(eval-query '(rule (append-to-form () ?y ?y)))
(eval-query
  '(rule (append-to-form (?u . ?v) ?y (?u . ?z))
         (append-to-form ?v ?y ?z)))

(eval-query '(append-to-form (a b) (c d) ?z)) (newline)
; (eval-query '(append-to-form (a b) ?y (a b c d))) (newline)
; (eval-query '(append-to-form ?x ?y (a b c d))) (newline)

(eval-query '(rule (?x next-to ?y in (?x ?y . ?u))))

(eval-query
  '(rule (?x next-to ?y in (?v . ?z))
         (?x next-to ?y in ?z)))

; (eval-query '(?x next-to ?y in (1 (2 3) 4))) (newline)
; (1 next-to (2 3))
; ((2 3) next-to  4)

; (eval-query '(?x next-to 1 in (2 1 3 1))) (newline)
; (2 next-to 1)
; (3 next-to 1)

(display "[answered]\n")

(display "\nex-4.62 - last-pair\n")

(eval-query '(rule (last-pair (?x . ()) (?x . ()))))
(eval-query
  '(rule (last-pair (?u . ?v) ?x)
         (last-pair ?v ?x)))

(eval-query '(last-pair (1 2 3) ?y))
(eval-query '(last-pair (3) ?y))
(eval-query '(last-pair (2 3 4 5 ?x) (3)))
(newline)

; (eval-query '(last-pair ?x (3))) results in an endless loop because there is
; no definite answer. Any arbitrary number of symbols before the 3 would form a
; solution.

(display "\nex-4.63 - genesis-family\n")

(eval-query '(rule (grandson ?grandparent ?grandson)
                   (and (nson ?grandparent ?son)
                        (nson ?son ?grandson))))

(eval-query '(rule (nson ?parent ?son)
                   (or (son ?parent ?son)
                       (and (wife ?parent ?wife)
                            (son ?wife ?son)))))

(eval-query '(grandson Cain ?x))
(eval-query '(nson Lamech ?x))
(eval-query '(grandson Methushael ?x))
(newline)

(display "\nex-4.64 - outranked-loop\n")

(eval-query
 '(rule (outranked-by-2 ?staff-person ?boss)
        (or (supervisor ?staff-person ?boss)
            (and (outranked-by-2 ?middle-manager ?boss)
                 (supervisor ?staff-person ?middle-manager)))))

; The first part of the or-clause finds a single stream. When evaluating the
; second part of the and clause ?middle-manager and ?boss are not assigned to
; any values yet. Therefore, in the recursive application of the rule
; outranked-by-2 is invoked again. Again, with no assignments. By swapping the
; two patterns in the and-clause the rule first creates frames and then invokes
; the recursive call. If supervisor does not return any results outranked-by-2
; is not invoked again and there is no endless-loop.

; (eval-query '(outranked-by-2 (Bitdiddle Ben) ?who))
(display "[answered]\n")

(display "\nex-4.65 - four-wheels\n")

;(rule (wheel ?person)
;      (and (supervisor ?middle-manager ?person)
;           (supervisor ?staff ?middle-manager)))

; The wheel rule returns a match for each staff person that is under a
; middle-manager. Ben and Eben are under Oliver. Ben supervises  Alyssa, Cy D,
; and Lem E. Eben supervises Robert. Hence, there are four results for Oliver.
; Louis works under Alyssa who works under Ben, which is why Ben only shows up
; once.

(eval-query '(wheel ?who))
(display "\n[answered]\n")

(display "\nex-4.66 - accumulation-function\n")

; Ben's solution would yield wrong results for a query like wheel where the
; same entry is returned multiple times. For the example provided, everything
; would work fine. So, I am not sure if this is what Ben has realized. A way to
; salvage the situation would be to apply a filter so that each ?x only occurs
; once.

(display "[answered]\n")

(display "\nex-4.67 - avoid-loops\n")

; Each application of a query generates a message that contains the rule name,
; the variables, and the variable bindings. Before we apply message we check if
; the message is in the message list in which case we skip the evaluation.
; Otherwise, we add message to the list and continue the evaluation.

(display "[answered]\n")

(display "\nex-4.68 - reverse\n")

(eval-query '(rule (reverse () ())))

(eval-query
  '(rule (reverse (?x . ?xs) ?rs)
         (and (reverse ?xs ?ys)
              (append-to-form ?ys (?x) ?rs))))

(eval-query '(reverse (1 2 3) ?x))
(newline)
; (eval-query '(reverse ?x (1 2 3))) ; infinite loop

(display "\nex-4.69 - greats\n")

(eval-query
  '(rule (greats ?relation ?parent ?grandson)
         (and (grandson ?parent ?grandson)
              (same ?relation (grandson)))))

(eval-query
  '(rule (greats ?relation ?parent ?grandson)
         (and (nson ?parent ?son)
              (greats ?son-relation ?son ?grandson)
              (append-to-form (great) ?son-relation ?relation))))

(eval-query '(greats ?x Adam Irad))
(eval-query '(greats ?x Adam Jabal))
(eval-query '(greats (great grandson) Adam ?ggs))
(newline)

(display "\nex-4.70\n")