SICP/ex-4_55-xx.scm

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

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

(define (eval-query input)
  (let ((q (query-syntax-process input)))
    (cond ((assertion-to-be-added? q)
           (add-rule-or-assertion! (add-assertion-body q)))
          (else
           (display-stream
            (stream-map
             (lambda (frame)
               (instantiate q
                            frame
                            (lambda (v f)
                              (contract-question-mark v))))
             (qeval q (singleton-stream '())))))))
  (newline))

(display "\nex-4.55 - simple-queries\n")

; a. all people supervised by Ben Bitdiddle;
(eval-query '(supervisor ?x (bitdiddle ben)))

; b. the names and jobs of all people in the accounting division;
(eval-query '(job ?x (accounting . ?y)))

; c. the names and addresses of all people who live in Slumerville.
(eval-query '(address ?x (slumerville . ?y)))

(display "\nex-4.56 - joint-queries\n")

; a. the names of all people who are supervised by Ben Bitdiddle, together with
; their addresses;
(eval-query
  '(and (supervisor ?person (Bitdiddle Ben))
        (address ?person  ?address)))

; b. all people whose salary is less than Ben Bitdiddle's, together with their
; salary and Ben Bitdiddle's salary;
(eval-query
  '(and (salary (Bitdiddle Ben) ?ben-amount)
        (salary ?person ?amount)
        (lisp-value > ?amount ?ben-amount)))

; c. all people who are supervised by someone who is not in the computer
; division, together with the supervisor's name and job.
(eval-query
  '(and (supervisor ?person ?supervisor)
        (not (job ?supervisor (computer . ?supervisor-title)))
        (job ?supervisor ?job)))

(display "\nex-4.57\n")