Ken%MIT-OZ@MIT-MC@sri-unix.UUCP (08/17/83)
r-n-p "More?")))
(t (try-each database database
(rest list-of-goals) (first list-of-goals)
environment level))))
(defun try-each (database-left database goals-left goal
environment level)
(cond ((null database-left)
()) ;; fail since nothing left in database
(t (let ((assertion
;; level is used to uniquely rename variables
(rename-variables (first database-left)
(list level))))
(let ((new-environment
(unify goal (first assertion) environment)))
(cond ((null new-environment) ;; failed to unify
(try-each (rest database-left)
database
goals-left
goal
environment level))
((prove (append (rest assertion) goals-left)
new-environment
database
(add1 level)))
(t (try-each (rest database-left)
database
goals-left
goal
environment
level))))))))
(defun unify (x y environment)
(let ((x (value x environment))
(y (value y environment)))
(cond ((variable-p x) (cons (list x y) environment))
((variable-p y) (cons (list y x) environment))
((or (atom x) (atom y))
(and (equal x y) environment))
(t (let ((new-environment
(unify (first x) (first y) environment)))
(and new-environment
(unify (rest x) (rest y)
new-environment)))))))
(defun value (x environment)
(cond ((variable-p x)
(let ((binding (assoc x environment)))
(cond ((null binding) x)
(t (value (second binding) environment)))))
(t x)))
(defun variable-p (x) ;; a variable is a list beginning with "?"
(and (listp x) (eq (first x) '?)))
(defun rename-variables (term list-of-level)
(cond ((variable-p term) (append term list-of-level))
((atom term) term)
(t (cons (rename-variables (first term)
list-of-level)
(rename-variables (rest term)
list-of-level)))))
(defun print-bindings (environment-left environment)
(cond ((rest environment-left)
(cond ((zerop
(third (first (first environment-left))))
(print
(second (first (first environment-left))))
(princ " = ")
(prin1 (value (first (first environment-left))
environment))))
(print-bindings (rest environment-left) environment))))
;; a sample database:
(setq db '(((father jack ken))
((father jack karen))
((grandparent (? grandparent) (? grandchild))
(parent (? grandparent) (? parent))
(parent (? parent) (? grandchild)))
((mother el ken))
((mother cele jack))
((parent (? parent) (? child))
(mother (? parent) (? child)))
((parent (? parent) (? child))
(father (? parent) (? child)))))
;; the following are utilities
(defun first (x) (car x))
(defun rest (x) (cdr x))
(defun second (x) (cadr x))
(defun third (x) (caddr x))