Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv27225

Modified Files: unifier.lisp Log Message: Major API change to 'unify'. It now accepts keywords. Old code shouls not be affected, but new code is now more flexible. Look the the STRING and (new) CHARACTER methods to see how this change is affecting the code.

--- /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2006/07/19 21:52:34 1.5 +++ /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2009/04/15 10:14:24 1.6 @@ -5,7 +5,7 @@

(in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow.

-(defgeneric unify (a b &optional env) +(defgeneric unify (a b &optional env &key &allow-other-keys) (:documentation "Unifies two objects A and B given a substitution ENV. A is a Common Lisp object and B is either a Common Lisp object or a @@ -22,7 +22,9 @@ ;;;=========================================================================== ;;; Simple, non template methods.

-(defmethod unify ((a symbol) (b list) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b list) + &optional (env (make-empty-environment)) + &key &allow-other-keys) "Unifies a symbol A and a list B in an environment ENV. If A is not a variable then an error of type UNIFICATION-FAILURE is signaled. If A is a unification variable, then the environment ENV is @@ -35,7 +37,9 @@ :format-arguments (list a b)))))

-(defmethod unify ((b list) (a symbol) &optional (env (make-empty-environment))) +(defmethod unify ((b list) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) "Unifies a symbol B and a list A in an environment ENV. If A is not a variable then an error of type UNIFICATION-FAILURE is signaled. If A is a unification variable, then the environment ENV is @@ -48,7 +52,9 @@ :format-arguments (list b a)))))

-(defmethod unify ((a list) (b list) &optional (env (make-empty-environment))) +(defmethod unify ((a list) (b list) + &optional (env (make-empty-environment)) + &key &allow-other-keys) "Unifies a list A and a list B in an environment ENV. The unification procedure proceedes recursively on each element of both lists. If two elements cannot be unified then an error of type @@ -58,7 +64,9 @@

-(defmethod unify ((a number) (b number) &optional (env (make-empty-environment))) +(defmethod unify ((a number) (b number) + &optional (env (make-empty-environment)) + &key &allow-other-keys) "Unifies two numbers A and B. Two numbers unify only if and only if they are equal as per the function #'=, in which case an unmodified envirironment ENV is returned. @@ -72,9 +80,35 @@ :format-arguments (list a b))))

-(defparameter *unify-string-case-insensitive-p* nil) +(defparameter *unify-string-case-sensitive-p* t)

-(defmethod unify ((a string) (b string) &optional (env (make-empty-environment))) +(defmethod unify ((a character) (b character) + &optional (env (make-empty-environment)) + &key + (case-sensitive *unify-string-case-sensitive-p*) + &allow-other-keys) + "Unifies two strings A and B. +Two CHARACTERs A and B unify if and only if they satisfy either #'CHAR= or +#'CHAR-EQUAL. The choice of which of test to perform (#'CHAR= or #'CHAR-EQUAL) +is made according to the value of the variable +*UNIFY-STRING-CASE-INSENSITIVE-P*, which defaults to NIL. +If A and B unify then an unmodified environment ENV is returned, +otherwise an error of type UNIFICATION-FAILURE is signaled." + (cond ((and case-sensitive (char= a b)) + env) + ((char-equal a b) + env) + (t + (error 'unification-failure + :format-control "Connot unify two different characters: ~S ~S." + :format-arguments (list a b))))) + + +(defmethod unify ((a string) (b string) + &optional (env (make-empty-environment)) + &key + (case-sensitive *unify-string-case-sensitive-p*) + &allow-other-keys) "Unifies two strings A and B. Two strings A and B unify if and only if they satisfy either #'STRING= or #'STRING-EQUAL. The choice of which of test to perform (#'STRING= or #'STRING-EQUAL) @@ -82,9 +116,9 @@ *UNIFY-STRING-CASE-INSENSITIVE-P*, which defaults to NIL. If A and B unify then an unmodified environment ENV is returned, otherwise an error of type UNIFICATION-FAILURE is signaled." - (cond ((and *unify-string-case-insensitive-p* (string-equal a b)) + (cond ((and case-sensitive (string= a b)) env) - ((string= a b) + ((string-equal a b) env) (t (error 'unification-failure @@ -92,7 +126,9 @@ :format-arguments (list a b)))))

-(defmethod unify ((a symbol) (b string) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b string) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure @@ -100,7 +136,9 @@ :format-arguments (list a b)))))

-(defmethod unify ((b string) (a symbol) &optional (env (make-empty-environment))) +(defmethod unify ((b string) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure @@ -108,7 +146,9 @@ :format-arguments (list b a)))))

-(defmethod unify ((a symbol) (b symbol) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) ((variable-any-p b) env) @@ -119,27 +159,36 @@ :format-arguments (list a b)))))

-(defmethod unify ((a symbol) (b t) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b t) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (call-next-method))))

-(defmethod unify ((b t) (a symbol) &optional (env (make-empty-environment))) +(defmethod unify ((b t) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (call-next-method))))

-(defmethod unify ((a symbol) (b array) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b array) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure - :format-control "Cannot unify a symbol with an array or vector: ~S and ~S." + :format-control "Cannot unify a symbol with ~ + an array or vector: ~S and ~S." :format-arguments (list a b)))))

-(defmethod unify ((b array) (a symbol) &optional (env (make-empty-environment))) +(defmethod unify ((b array) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure @@ -147,7 +196,9 @@ :format-arguments (list a b)))))

-(defmethod unify ((as vector) (bs vector) &optional (env (make-empty-environment))) +(defmethod unify ((as vector) (bs vector) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unless (= (length as) (length bs)) (error 'unification-failure :format-control "Cannot unify two vectors of different length: ~D and ~D." @@ -158,7 +209,9 @@ finally (return mgu)))

-(defmethod unify ((s1 sequence) (s2 sequence) &optional (env (make-empty-environment))) +(defmethod unify ((s1 sequence) (s2 sequence) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unless (= (length s1) (length s2)) (error 'unification-failure :format-control "Cannot unify two sequences of different length: ~D and ~D." @@ -186,7 +239,9 @@ (unify a b env))

-(defmethod unify ((as array) (bs array) &optional (env (make-empty-environment))) +(defmethod unify ((as array) (bs array) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unless (= (array-total-size as) (array-total-size bs)) (error 'unification-failure :format-control "Cannot unify two arrays of different total size: ~D and ~D." @@ -200,7 +255,9 @@

;;; Catch all method.

-(defmethod unify ((a t) (b t) &optional (env (make-empty-environment))) +(defmethod unify ((a t) (b t) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (if (equalp a b) env (error 'unification-failure @@ -229,10 +286,13 @@

;;; Special catch all method.

-(defmethod unify ((x template) (y template) &optional (env (make-empty-environment))) +(defmethod unify ((x template) (y template) + &optional (env) + &key &allow-other-keys) (declare (ignore env)) (error 'unification-failure - :format-control "Unification of two templates of type ~A and ~A has not been yet implemented." + :format-control "Unification of two templates of type ~A and ~A ~ + has not been yet implemented." :format-arguments (list (class-name (class-of x)) (class-name (class-of y)))))

@@ -241,45 +301,58 @@ ;;; NIL special unification methods.

(defmethod unify ((x null) (y null) - &optional (env (make-empty-environment))) + &optional (env (make-empty-environment)) + &key &allow-other-keys) env)

(defmethod unify ((x null) (nt nil-template) - &optional (env (make-empty-environment))) + &optional (env (make-empty-environment)) + &key &allow-other-keys) env)

(defmethod unify ((nt nil-template) (x null) - &optional (env (make-empty-environment))) + &optional (env (make-empty-environment)) + &key &allow-other-keys) env)

(defmethod unify ((nt1 nil-template) (nt2 nil-template) - &optional (env (make-empty-environment))) + &optional (env (make-empty-environment)) + &key &allow-other-keys) env)

;;;--------------------------------------------------------------------------- ;;; Symbol methods.

-(defmethod unify ((a symbol) (b symbol-template) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b symbol-template) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (unify a (symbol-template-symbol b) env))))

-(defmethod unify ((b symbol-template) (a symbol) &optional (env (make-empty-environment))) +(defmethod unify ((b symbol-template) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

-(defmethod unify ((a symbol) (b template) &optional (env (make-empty-environment))) +(defmethod unify ((a symbol) (b template) + &optional (env) + &key &allow-other-keys) (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify symbol ~S with template ~S." :format-arguments (list a b)))

-(defmethod unify ((b template) (a symbol) &optional (env (make-empty-environment))) + +(defmethod unify ((b template) (a symbol) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

@@ -287,47 +360,74 @@ ;;;--------------------------------------------------------------------------- ;;; Number template methods.

-(defmethod unify ((a number) (b number-template) &optional (env (make-empty-environment))) +(defmethod unify ((a number) (b number-template) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a (number-template-number b) env))

-(defmethod unify ((b number-template) (a number) &optional (env (make-empty-environment))) +(defmethod unify ((b number-template) (a number) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

-(defmethod unify ((a number) (b template) &optional (env (make-empty-environment))) +(defmethod unify ((a number) (b template) + &optional (env) + &key &allow-other-keys) (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify the number ~S with template ~S." :format-arguments (list a b)))

-(defmethod unify ((b template) (a number) &optional (env (make-empty-environment))) +(defmethod unify ((b template) (a number) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

;;;--------------------------------------------------------------------------- ;;; Sequence (List) template methods

-(defmethod unify ((a sequence) (b template) &optional (env (make-empty-environment))) +(defmethod unify ((a sequence) (b template) + &optional (env) + &key &allow-other-keys) (declare (ignore env)) (error 'unification-failure - :format-control "Cannot unify a sequence with a non sequence or non sequence access template: ~S ~S." + :format-control "Cannot unify a sequence with a non sequence ~ + or non sequence access template: ~S and ~S." :format-arguments (list a b)))

-(defmethod unify ((b template) (a sequence) &optional (env (make-empty-environment))) +(defmethod unify ((b template) (a sequence) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

+#| Needs to be fixed. +(defmethod unify ((a list) (b lambda-template) &optional (env (make-empty-environment))) + (unify a (template-spec b) env)) + + +(defmethod unify ((b lambda-template) (a list) &optional (env (make-empty-environment))) + (unify (template-spec b) a env)) +|# + + ;;; The next is incomplete and does not signal appropriate errors.

-(defmethod unify ((a list) (b template) &optional (env (make-empty-environment))) +(defmethod unify ((a list) (b template) + &optional (env) + &key &allow-other-keys) (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify a list with a non-list template: ~S ~S." :format-arguments (list a b)))

-(defmethod unify ((a list) (b sequence-template) &optional (env (make-empty-environment))) +(defmethod unify ((a list) (b sequence-template) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (let ((template-lambda-list (sequence-template-lambda-list b)) (ll (list-length a)) ) @@ -355,7 +455,9 @@

-(defmethod unify ((b template) (a list) &optional (env (make-empty-environment))) +(defmethod unify ((b template) (a list) + &optional (env (make-empty-environment)) + &key &allow-other-keys) (unify a b env))

[368 lines skipped]