57 lines
1.7 KiB
Scheme
57 lines
1.7 KiB
Scheme
(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")
|
|
|
|
|