Chapter 4, Metalinguistic Abstraction

Exercise 4.75


Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
;;Add this line in the initialize-database procedure    
;; (put 'unique 'qeval uniquely-asserted)

(define (unique-query exps) (car exps))

(define (uniquely-asserted operands frame-stream)
  (simple-stream-flatmap
   (lambda (frame)
	 (let ((matched-frame-stream (qeval (unique-query operands)
								  (singleton-stream frame))))
	   (if (or (stream-null? matched-frame-stream)
			   (not (stream-null? (stream-cdr matched-frame-stream))))
		   the-empty-stream
		   matched-frame-stream)))
   frame-stream))

Output:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;; Query input:
(unique (job ?x (computer wizard)))

;;; Query results:
(unique (job (bitdiddle ben) (computer wizard)))

;;; Query input:
(unique (job ?x (computer programmer)))

;;; Query results:

;;; Query input:
(and (job ?x ?j) (unique (job ?anyone ?j)))

;;; Query results:
(and (job (aull dewitt) (administration secretary)) (unique (job (aull dewitt) (administration secretary))))
(and (job (cratchet robert) (accounting scrivener)) (unique (job (cratchet robert) (accounting scrivener))))
(and (job (scrooge eben) (accounting chief accountant)) (unique (job (scrooge eben) (accounting chief accountant))))
(and (job (warbucks oliver) (administration big wheel)) (unique (job (warbucks oliver) (administration big wheel))))
(and (job (reasoner louis) (computer programmer trainee)) (unique (job (reasoner louis) (computer programmer trainee))))
(and (job (tweakit lem e) (computer technician)) (unique (job (tweakit lem e) (computer technician))))
(and (job (bitdiddle ben) (computer wizard)) (unique (job (bitdiddle ben) (computer wizard))))

;;; Query input: