Implement 4.57 and update eval-query to support rules
parent
186bab6569
commit
5eb7a24687
|
@ -3,10 +3,15 @@
|
|||
|
||||
(initialize-data-base microshaft-data-base)
|
||||
|
||||
(define (rule-to-be-added? exp)
|
||||
(eq? (car exp) 'rule))
|
||||
|
||||
(define (eval-query input)
|
||||
(let ((q (query-syntax-process input)))
|
||||
(cond ((assertion-to-be-added? q)
|
||||
(add-rule-or-assertion! (add-assertion-body q)))
|
||||
((rule-to-be-added? q)
|
||||
(add-rule-or-assertion! q))
|
||||
(else
|
||||
(display-stream
|
||||
(stream-map
|
||||
|
@ -15,19 +20,21 @@
|
|||
frame
|
||||
(lambda (v f)
|
||||
(contract-question-mark v))))
|
||||
(qeval q (singleton-stream '())))))))
|
||||
(newline))
|
||||
(qeval q (singleton-stream '()))))))))
|
||||
|
||||
(display "\nex-4.55 - simple-queries\n")
|
||||
|
||||
; a. all people supervised by Ben Bitdiddle;
|
||||
(eval-query '(supervisor ?x (bitdiddle ben)))
|
||||
(newline)
|
||||
|
||||
; b. the names and jobs of all people in the accounting division;
|
||||
(eval-query '(job ?x (accounting . ?y)))
|
||||
(newline)
|
||||
|
||||
; c. the names and addresses of all people who live in Slumerville.
|
||||
(eval-query '(address ?x (slumerville . ?y)))
|
||||
(newline)
|
||||
|
||||
(display "\nex-4.56 - joint-queries\n")
|
||||
|
||||
|
@ -36,6 +43,7 @@
|
|||
(eval-query
|
||||
'(and (supervisor ?person (Bitdiddle Ben))
|
||||
(address ?person ?address)))
|
||||
(newline)
|
||||
|
||||
; b. all people whose salary is less than Ben Bitdiddle's, together with their
|
||||
; salary and Ben Bitdiddle's salary;
|
||||
|
@ -43,6 +51,7 @@
|
|||
'(and (salary (Bitdiddle Ben) ?ben-amount)
|
||||
(salary ?person ?amount)
|
||||
(lisp-value > ?amount ?ben-amount)))
|
||||
(newline)
|
||||
|
||||
; c. all people who are supervised by someone who is not in the computer
|
||||
; division, together with the supervisor's name and job.
|
||||
|
@ -50,7 +59,34 @@
|
|||
'(and (supervisor ?person ?supervisor)
|
||||
(not (job ?supervisor (computer . ?supervisor-title)))
|
||||
(job ?supervisor ?job)))
|
||||
(newline)
|
||||
|
||||
(display "\nex-4.57\n")
|
||||
(display "\nex-4.57 - rules\n")
|
||||
|
||||
(eval-query '(rule (same ?x ?x)))
|
||||
|
||||
(eval-query
|
||||
'(rule (can-replace ?p1 ?p2)
|
||||
(and (or (and (job ?p1 ?j) (job ?p2 ?j))
|
||||
(and (job ?p1 ?j1)
|
||||
(job ?p2 ?j2)
|
||||
(can-do-job ?j1 ?j2)))
|
||||
(not (same ?p1 ?p2)))))
|
||||
|
||||
; a. all people who can replace Cy D. Fect;
|
||||
(eval-query '(can-replace (fect cy d) ?x))
|
||||
(newline)
|
||||
|
||||
; b. all people who can replace someone who is being paid more than they are,
|
||||
; together with the two salaries.
|
||||
(eval-query
|
||||
'(and (can-replace ?p1 ?p2)
|
||||
(salary ?p1 ?s1)
|
||||
(salary ?p2 ?s2)
|
||||
(lisp-value < ?s1 ?s2)))
|
||||
(newline)
|
||||
|
||||
(display "\nex-4.58\n")
|
||||
|
||||
(display "\nex-4.59\n")
|
||||
|
||||
|
|
Loading…
Reference in New Issue