;;; net.scm                    Dave Reed ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define ANIMAL-NET
  '((canary can sing) (canary is yellow) (canary is-a bird)
    (ostrich is tall) (ostrich (not can) fly) (ostrich is-a bird)
    (bird can fly) (bird has wings) (bird has feathers) (bird is-a animal)
    (fish is-a animal)
    (animal can breathe) (animal can move) (animal has skin)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;(define (lookup object property value NETWORK)
;;;  
;;;  (define (get-parents object NET)
;;;    (cond ((null? NET) '())
;;;          ((and (equal? object (caar NET)) (equal? 'is-a (cadar NET)))
;;;           (cons (caddar NET) (get-parents object (cdr NET))))
;;;          (else (get-parents object (cdr NET)))))
;;;  
;;;  (define (inherit parents)
;;;    (if (null? parents) 
;;;        #f
;;;        (or (lookup (car parents) property value NETWORK)
;;;            (inherit (cdr parents)))))
;;;    
;;;  (if (member (list object property value) NETWORK)
;;;      #t
;;;     (inherit (get-parents object NETWORK))))
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (lookup object property value NETWORK)
  
  (define (opposite property)
    (if (symbol? property) 
        (list 'not property)
        (cadr property)))
  
  (define (get-parents object NET)
    (cond ((null? NET) '())
          ((and (equal? object (caar NET)) (equal? 'is-a (cadar NET)))
           (cons (caddar NET) (get-parents object (cdr NET))))
          (else (get-parents object (cdr NET)))))
  
  (define (inherit parents)
    (if (null? parents) 
        #f
        (or (lookup (car parents) property value NETWORK)
            (inherit (cdr parents)))))
    
  (cond ((member (list object property value) NETWORK) #t)
        ((member (list object (opposite property) value) NETWORK) #f)
        (else (inherit (get-parents object NETWORK)))))