- cl-unification-cvs@lists.common-lisp.net

[cl-unification-cvs] CVS cl-unification
by mantoniotti 18 Jan '11

18 Jan '11

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18209 Modified Files: COPYING Log Message: Copyright dates updated. --- /project/cl-unification/cvsroot/cl-unification/COPYING 2009/04/15 10:14:59 1.5 +++ /project/cl-unification/cvsroot/cl-unification/COPYING 2011/01/18 14:54:08 1.6 @@ -1,4 +1,4 @@ -Copyright (c) 2004-2009 Marco Antoniotti +Copyright (c) 2004-2011 Marco Antoniotti All rights reserved. Permission is hereby granted, without written agreement and without

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 18 Jan '11

18 Jan '11

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18168 Modified Files: ChangeLog Log Message: ChangeLog updated. --- /project/cl-unification/cvsroot/cl-unification/ChangeLog 2009/12/17 17:02:42 1.8 +++ /project/cl-unification/cvsroot/cl-unification/ChangeLog 2011/01/18 14:53:20 1.9 @@ -1,3 +1,39 @@ +2011-01-18 author <author(a)paniscia.local> + + * unifier.lisp: + After a careful reading of PAIP fixed a very subtle bug in VAR-UNIFY + that prevented the correct unification of: + + (?x ?y a) + + with + + (?y ?x ?x) + + * substitutions.lisp: + Added debugging functions DUMP-FRAME and DUMP-ENVIRONMENT. + + * .cvsignore: Added .cvsignore file. + +2009-12-17 author <author(a)paniscia.local> + + * ChangeLog: ChangeLog updated. + + * lib-dependent/cl-ppcre-template.asd: Initial checkin. + + * lib-dependent/cl-ppcre-template.lisp: + Patched to use Cl-PPCRE:SCAN-TO-STRINGS (thanks to Pixel // pinterface [a] gmail dot com). + + * unifier.lisp: Minor cosmetic changes. + + * unification-package.lisp: Exported MATCHF-CASE. + + * templates-hierarchy.lisp: + Fixed a couple of problems with some accessors in the NUMBER, + STRUCTURE-OBJECT and STANDARD-OBJECT templates. + + * match-block.lisp: Added MATCHF* macros. + 2009-12-17 author <author(a)paniscia.local> * lib-dependent/cl-ppcre-template.asd: Initial checkin.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 18 Jan '11

18 Jan '11

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18091 Modified Files: unifier.lisp Log Message: After a careful reading of PAIP fixed a very subtle bug in VAR-UNIFY that prevented the correct unification of: (?x ?y a) with (?y ?x ?x) --- /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2009/12/17 16:44:46 1.7 +++ /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2011/01/18 14:50:17 1.8 @@ -880,6 +880,8 @@ (defgeneric occurs-in-p (var pat env)) + +#+old-version-no-paip (defun var-unify (var pat env) (if (eq var pat) env @@ -896,6 +898,33 @@ (extend-environment var pat env)))))) +;;; Version with PAIP test. + +(defun var-unify (var pat env) + (if (eq var pat) + env + (multiple-value-bind (value foundp) + (find-variable-value var env) + + (cond (foundp + (unify value pat env)) + ((variablep pat) + (multiple-value-bind (pat-value foundp) + (find-variable-value pat env) + (if foundp + (return-from var-unify + (unify var pat-value env))) + ))) + + (cond ((and *occurrence-check-p* + (occurs-in-p var pat env)) + (error 'unification-failure + :format-control "Variable ~S occurs in ~S." + :format-arguments (list var pat))) + (t + (extend-environment var pat env)))))) + + #|| (defmethod occurs-in-p ((var symbol) pat env)

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 18 Jan '11

18 Jan '11

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18024 Modified Files: substitutions.lisp Log Message: Added debugging functions DUMP-FRAME and DUMP-ENVIRONMENT. --- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2009/04/15 10:17:48 1.5 +++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2011/01/18 14:48:02 1.6 @@ -182,6 +182,18 @@ (mapcan #'frame-values (environment-frames env))) +;;;--------------------------------------------------------------------------- +;;; Simple debugging. +(defun dump-frame (f &optional (out *standard-output*)) + (declare (type frame f)) + (terpri out) + (loop for (var . value) in (frame-bindings f) + do (format out "~A~VT= ~A~%" var 8 value)) + ) + +(defun dump-environment (env &optional (out *standard-output*)) + (declare (type environment env)) + (map nil #'(lambda (f) (dump-frame f out)) (environment-frames env))) ;;;; end of file -- substitutions.lisp --

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 18 Jan '11

18 Jan '11

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv17948 Added Files: .cvsignore Log Message: Added .cvsignore file. --- /project/cl-unification/cvsroot/cl-unification/.cvsignore 2011/01/18 14:46:42 NONE +++ /project/cl-unification/cvsroot/cl-unification/.cvsignore 2011/01/18 14:46:42 1.1 *.*fasl *.*fsl

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv26456 Modified Files: ChangeLog Log Message: ChangeLog updated. --- /project/cl-unification/cvsroot/cl-unification/ChangeLog 2009/04/17 22:44:17 1.7 +++ /project/cl-unification/cvsroot/cl-unification/ChangeLog 2009/12/17 17:02:42 1.8 @@ -1,3 +1,35 @@ +2009-12-17 author <author(a)paniscia.local> + + * lib-dependent/cl-ppcre-template.asd: Initial checkin. + + * lib-dependent/cl-ppcre-template.lisp: + Patched to use Cl-PPCRE:SCAN-TO-STRINGS (thanks to Pixel // pinterface [a] gmail dot com). + + * unifier.lisp: Minor cosmetic changes. + + * unification-package.lisp: Exported MATCHF-CASE. + + * templates-hierarchy.lisp: + Fixed a couple of problems with some accessors in the NUMBER, + STRUCTURE-OBJECT and STANDARD-OBJECT templates. + + * match-block.lisp: Added MATCHF* macros. + +2009-04-18 author <author(a)paniscia.local> + + * ChangeLog: ChangeLog updated. + + * cl-unification.system, cl-unification.asd: + System definitions files (.asd and .system) modified in order to make + dependency form CL-PPCRE optional. + + * lib-dependent/cl-ppcre-template.system: File added. + + * lib-dependent/cl-ppcre-template.lisp: + Removed REQUIRE of CL-PPCRE. Too brittle. + + * cl-unification-lib.asd: File added. + 2009-04-18 author <author(a)Macintosh-9.local> * cl-unification.system, cl-unification.asd:

1 0

[cl-unification-cvs] CVS cl-unification/lib-dependent
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification/lib-dependent In directory cl-net:/tmp/cvs-serv25442 Added Files: cl-ppcre-template.asd Log Message: Initial checkin. --- /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.asd 2009/12/17 17:00:58 NONE +++ /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.asd 2009/12/17 17:00:58 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-ppcre-template.asd -- ;;;; ASDF system file. (asdf:defsystem cl-ppcre-template :author "Marco Antoniotti" :components ((:file "cl-ppcre-template")) :depends-on (cl-ppcre cl-unification)) ;;;; end of file -- cl-ppcre-template.asd --

1 0

[cl-unification-cvs] CVS cl-unification/lib-dependent
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification/lib-dependent In directory cl-net:/tmp/cvs-serv20396 Modified Files: cl-ppcre-template.lisp Log Message: Patched to use Cl-PPCRE:SCAN-TO-STRINGS (thanks to Pixel // pinterface [a] gmail dot com). --- /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/04/17 22:40:29 1.2 +++ /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/12/17 16:57:45 1.3 @@ -120,13 +120,10 @@ (type (or null (integer 0 #.most-positive-fixnum)) end)) (let ((end (or end (length s)))) (declare (type (integer 0 #.most-positive-fixnum) end)) - (multiple-value-bind (m-start m-end r-starts r-ends) - (cl-ppcre:scan (scanner re-t) s :start start :end end) - ;; Maybe SCAN-TO-STRINGS would be simpler to use... - (declare (type (integer 0 #.most-positive-fixnum) m-start m-end) - (type (vector (integer 0 #.most-positive-fixnum)) r-starts r-ends)) - (unless (and (= start m-start) (= m-end end)) + (multiple-value-bind (matched-p strings) + (cl-ppcre:scan-to-strings (scanner re-t) s :start start :end end) + (unless matched-p (error 'unification-failure :format-control "String ~S cannot be matched against ~ regular expression ~S." @@ -135,9 +132,7 @@ (let ((vars (variables re-t))) (if (null vars) env - (loop for r-start across r-starts - for r-end across r-ends - for r-string of-type string = (subseq s r-start r-end) + (loop for r-string of-type string across strings for v in vars for result-env = (var-unify v r-string env) then (var-unify v r-string result-env)

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18834 Modified Files: unifier.lisp Log Message: Minor cosmetic changes. --- /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2009/04/15 10:14:24 1.6 +++ /project/cl-unification/cvsroot/cl-unification/unifier.lisp 2009/12/17 16:44:46 1.7 @@ -225,14 +225,16 @@ (defgeneric untyped-unify (a b &optional env)) -(defmethod untyped-unify ((as list) (bs vector) &optional (env (make-empty-environment))) +(defmethod untyped-unify ((as list) (bs vector) + &optional (env (make-empty-environment))) (loop for a in as for b across bs for mgu = (unify a b env) then (unify a b mgu) finally (return mgu))) -(defmethod untyped-unify ((as vector) (bs list) &optional (env (make-empty-environment))) +(defmethod untyped-unify ((as vector) (bs list) + &optional (env (make-empty-environment))) (untyped-unify bs as env)) (defmethod untyped-unify ((a t) (b t) &optional (env (make-empty-environment))) @@ -449,7 +451,7 @@ (setf env (unify (subseq a n-vars (+ n-vars n-optionals)) optionals env))) (when (and rest (>= ll (+ n-vars n-optionals))) (setf env (unify (subseq a (+ n-vars n-optionals)) (first rest) env))) - (when keys (warn "Sorry mathcing of keywords ~S not yet implemented." keys)) + (when keys (warn "Sorry matching of keywords ~S not yet implemented." keys)) env ))))

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18747 Modified Files: unification-package.lisp Log Message: Exported MATCHF-CASE. --- /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2009/04/17 07:53:58 1.6 +++ /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2009/12/17 16:43:51 1.7 @@ -41,7 +41,9 @@ "MATCH" "MATCHF" "MATCHING" - "MATCH-CASE") + "MATCH-CASE" + "MATCHF-CASE" + ) (:export "UNIFY*"

1 0