sicp-ex-4.75



<< Previous exercise (4.74) | Index | Next exercise (4.76) >>


meteorgan

  
  
 ;; add those code 
 (define (uniquely-asserted pattern frame-stream) 
  (stream-flatmap 
   (lambda (frame) 
    (let ((stream (qeval (negated-query pattern) 
                                         (singleton-stream frame)))) 
         (if (singleton-stream? stream) 
             stream 
             the-empty-stream))) 
   frame-stream)) 
 (put 'unique 'qeval uniquely-asserted) 
  
 (define (singleton-stream? s) 
  (and (not (stream-null? s)) 
       (stream-null? (stream-cdr s)))) 
  
 ;;; Query input: 
 (and (supervisor ?person ?boss) (unique (supervisor ?other ?boss))) 
  
 ;;; Query output: 
 (and (supervisor (Cratchet Robert) (Scrooge Eben)) (unique (supervisor (Cratchet Robert) (Scrooge Eben)))) 
 (and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P))))