Unify.LisP

code
 * -*- Mode: Lisp; Syntax: Common-Lisp; -*-
 * Code from Paradigms of Artificial Intelligence Programming
 * Copyright (c) 1991 Peter Norvig


 * File unify.lisp: Unification functions

(requires "patmatch")

(defparameter *occurs-check* t "Should we do the occurs check?")

(defun unify (x y &optional (bindings no-bindings)) "See if x and y match with given bindings."  (cond ((eq bindings fail) fail) ((eql x y) bindings) ((variable-p x) (unify-variable x y bindings)) ((variable-p y) (unify-variable y x bindings)) ((and (consp x) (consp y))        (unify (rest x) (rest y)                (unify (first x) (first y) bindings))) (t fail)))

(defun unify-variable (var x bindings) "Unify var with x, using (and maybe extending) bindings."  (cond ((get-binding var bindings)         (unify (lookup var bindings) x bindings)) ((and (variable-p x) (get-binding x bindings))        (unify var (lookup x bindings) bindings)) ((and *occurs-check* (occurs-check var x bindings))        fail) (t (extend-bindings var x bindings))))

(defun occurs-check (var x bindings) "Does var occur anywhere inside x?"  (cond ((eq var x) t)        ((and (variable-p x) (get-binding x bindings))         (occurs-check var (lookup x bindings) bindings)) ((consp x) (or (occurs-check var (first x) bindings) (occurs-check var (rest x) bindings))) (t nil)))



(defun subst-bindings (bindings x) "Substitute the value of variables in bindings into x,  taking recursively bound variables into account."  (cond ((eq bindings fail) fail) ((eq bindings no-bindings) x)       ((and (variable-p x) (get-binding x bindings))         (subst-bindings bindings (lookup x bindings))) ((atom x) x)       (t (reuse-cons (subst-bindings bindings (car x)) (subst-bindings bindings (cdr x)) x))))



(defun unifier (x y) "Return something that unifies with both x and y (or fail)." (subst-bindings (unify x y) x)) code