From mantoniotti at common-lisp.net Wed Jul 19 20:28:49 2006 From: mantoniotti at common-lisp.net (mantoniotti) Date: Wed, 19 Jul 2006 16:28:49 -0400 (EDT) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20060719202849.DFC676D027@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv19365 Modified Files: unification-package.lisp Log Message: Added missing export. --- /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2004/11/17 22:19:55 1.1.1.1 +++ /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2006/07/19 20:28:49 1.2 @@ -17,6 +17,7 @@ "MAKE-EMPTY-ENVIRONMENT") (:export "MATCH" - "MATCHING")) + "MATCHING" + "MATCH-CASE")) ;;; end of file -- unification-package.lisp -- From mantoniotti at common-lisp.net Wed Jul 19 21:52:34 2006 From: mantoniotti at common-lisp.net (mantoniotti) Date: Wed, 19 Jul 2006 17:52:34 -0400 (EDT) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20060719215234.AD6AC200B@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv30069 Modified Files: templates-hierarchy.lisp unifier.lisp Log Message: Fixed two problems with the unifier machinery. The first one had to do with the matching of NIL against SYMBOL and LIST in several places: essentially, the problem is incongruencies in the results of COMPUTE-APPLICABLE-METHODS in these cases. I think I caught most of them: unification of lists and the occur-check were the obvious places where things went awry. The second problem had to do with the reader macro #T. The original code generated an object at read time, which is not such a good idea. Now the code generates a call to MAKE-TEMPLATE with is evaluated later. Incidentally, the reader macro function is now called |sharp-T-reader|, in order to placate Emacs fontification. Modified Files: templates-hierarchy.lisp unifier.lisp --- /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2005/04/27 20:44:25 1.2 +++ /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2006/07/19 21:52:34 1.3 @@ -221,17 +221,33 @@ ;;; Setting up the reader macro. -(defun |#T-reader| (stream subchar arg) +#|| +(defun |sharp-T-reader| (stream subchar arg) (declare (ignore subchar arg)) (let ((spec (read stream t nil t))) (typecase spec (null (make-template nil spec)) (cons (make-template (first spec) spec)) (t (make-template spec spec))))) +||# + + +;;; New version with more 'macro-like' behavior. The previous version +;;; created an object at read-time, which may cause problems with +;;; MAKE-LOAD-FORMs, constant-ness etc etc. + +(defun |sharp-T-reader| (stream subchar arg) + (declare (ignore subchar arg)) + (let ((spec (read stream t nil t))) + (typecase spec + (null `(make-template nil ',spec)) + (cons `(make-template ',(first spec) ',spec)) + (t `(make-template ',spec ',spec))) + )) (eval-when (:load-toplevel :execute) - (set-dispatch-macro-character #\# #\T #'|#T-reader|)) + (set-dispatch-macro-character #\# #\T #'|sharp-T-reader|)) (defmethod make-template ((kind null) (spec symbol)) (assert (null spec) (spec) "MAKE-TEMPLATE called erroneously with ~S and ~S." kind spec) --- /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2005/10/25 19:17:33 1.4 +++ /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2006/07/19 21:52:34 1.5 @@ -230,6 +230,7 @@ ;;; Special catch all method. (defmethod unify ((x template) (y template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Unification of two templates of type ~A and ~A has not been yet implemented." :format-arguments (list (class-name (class-of x)) @@ -239,15 +240,23 @@ ;;;--------------------------------------------------------------------------- ;;; NIL special unification methods. -(defmethod unify ((x null) (nt nil-template) &optional (env (make-empty-environment))) +(defmethod unify ((x null) (y null) + &optional (env (make-empty-environment))) + env) + + +(defmethod unify ((x null) (nt nil-template) + &optional (env (make-empty-environment))) env) -(defmethod unify ((nt nil-template) (x null) &optional (env (make-empty-environment))) +(defmethod unify ((nt nil-template) (x null) + &optional (env (make-empty-environment))) env) -(defmethod unify ((nt1 nil-template) (nt2 nil-template) &optional (env (make-empty-environment))) +(defmethod unify ((nt1 nil-template) (nt2 nil-template) + &optional (env (make-empty-environment))) env) @@ -299,6 +308,7 @@ ;;; Sequence (List) template methods (defmethod unify ((a sequence) (b template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify a sequence with a non sequence or non sequence access template: ~S ~S." :format-arguments (list a b))) @@ -354,6 +364,7 @@ ;;; Vector template methods. (defmethod unify ((a vector) (b template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify a vector with a non-vector template: ~S ~S." :format-arguments (list a b))) @@ -398,6 +409,7 @@ ;;; Array template methods. (defmethod unify ((a array) (b template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify an array with a non array or non array access template: ~S ~S." :format-arguments (list a b))) @@ -447,7 +459,7 @@ ;; Template is (array (['*' | ] []) ) (destructuring-bind (array-kwd type-spec shape-template) template-spec - (declare (ignore array-kwd)) + (declare (ignore array-kwd type-spec)) ;; Missing check for type-spec. (unify-array-rows a shape-template env)) ))) @@ -458,11 +470,12 @@ ;;; Standard object template methods. (defmethod unify ((a standard-object) (b template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify a standard object with a non standard object template: ~S ~S." :format-arguments (list a b))) -#| Old version with heavy syntax +#|| Old version with heavy syntax (defmethod unify ((a standard-object) (b standard-object-template) &optional (env (make-empty-environment))) (destructuring-bind (class &rest template-slot-specs) @@ -484,7 +497,7 @@ then (slot-spec-unify accessor-spec reader value-template mgu) finally (return mgu)) env)))) -|# +||# (defmethod unify ((a standard-object) (b standard-object-template) @@ -519,6 +532,7 @@ ;;; Structure object template methods. (defmethod unify ((a structure-object) (b template) &optional (env (make-empty-environment))) + (declare (ignore env)) (error 'unification-failure :format-control "Cannot unify a structure object with a non structure object template: ~S ~S." :format-arguments (list a b))) @@ -553,7 +567,9 @@ (let* ((seq-type (type-of a)) (seq-template-kind (if (symbolp seq-type) seq-type (first seq-type))) ; Stupid FTTB. ) - (unify (subseq a from to) (make-template seq-template-kind `(,seq-template-kind , at spec)))))) + (unify (subseq a from to) + (make-template seq-template-kind `(,seq-template-kind , at spec)) + env)))) (defmethod unify ((b subseq-template) (a sequence) &optional (env (make-empty-environment))) @@ -597,7 +613,7 @@ -#| +#|| (defmethod occurs-in-p ((var symbol) pat env) (cond ((variablep pat) (or (eq var pat) @@ -612,7 +628,8 @@ (occurs-in-p var (rest pat) env))) (t (error "unimplemented")))) -|# +||# + (defmethod occurs-in-p ((var symbol) (pat symbol) env) (when (variablep pat) @@ -623,10 +640,21 @@ (occurs-in-p var value env))) ))) + (defmethod occurs-in-p ((var symbol) (pat list) env) (or (occurs-in-p var (first pat) env) (occurs-in-p var (rest pat) env))) + +(defmethod occurs-in-p ((var symbol) (pat null) env) + ;; This is needed because of different precedence rules among lisps + ;; in COMPUTE-APPLICABLE-METHODS when NIL has to matched against + ;; SYMBOL and LIST. + + ;; We know (assume) that VAR is not NIL. + nil) + + (defmethod occurs-in-p ((var symbol) (pat array) env) (loop for i from 0 below (array-total-size pat) thereis (occurs-in-p var (row-major-aref pat i) env)))