July 2008 - cl-unification-cvs@common-lisp.net

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv2799 Modified Files: ChangeLog Log Message: Changelog updated. --- /project/cl-unification/cvsroot/cl-unification/ChangeLog 2007/11/09 13:47:00 1.4 +++ /project/cl-unification/cvsroot/cl-unification/ChangeLog 2008/07/13 13:36:42 1.5 @@ -1,4 +1,80 @@ -2007-11-09 author <author(a)papadopoulou-2.ydras.offices.aueb.gr> +2008-07-13 author <author(a)Macintosh.local> + + * ACKNOWLEDGEMENTS: + Added credits to a few people. Missing ones should bug the maintainer :) + + * README: Copyright dates updated. + + * unification.asd, unification.system: Cleaning up. + Committing in . + + Removed Files: + unification.asd unification.system + + * templates-hierarchy-saved.lisp: Cleaning up. + Committing in . + + Removed Files: + templates-hierarchy-saved.lisp + + * INSTALLATION: Instructions updated. + + * COPYING: Copyright dates updated. + + * test/unification-tests.lisp: Added file. + + * substitutions.lisp, templates-hierarchy.lisp, unification-package.lisp, variables.lisp: + Some modification added. Exported symbols and reverted + reader macro #T to construct template instances at read time. + Added MAKE-LOAD-FORM method for templates which should fix problem with + SBCL. + + Committing in . + + Modified Files: + substitutions.lisp templates-hierarchy.lisp + unification-package.lisp variables.lisp + + * cl-unification.system: + Added explicit :source-extension to accomodate Allegro CL. + +2008-07-10 author <author(a)Macintosh.local> + + * apply-substitution.lisp: + Removed EXPORT of APPLY-SUBSTITUTION as it is already in the DEFPACKAGE. + +2007-11-09 author <author(a)Macintosh.local> + + * docs/html/index.html: Changed the position of the disclaimer. + + * ChangeLog: ChangeLog updated. + + * match-block.lisp: + Made several changes to improve MATCH-CASE (following a note from Ivan + Boldyrev from a long time ago), MATCHING and MATCH. + + Else-clauses are now handled correctly (AFAICT). + + Single variable templates in MATCH, MATCH-CASE and MATCHING clauses do + not need to be quoted. + + MATCHING was generating one gensym'ed variable per clause without + creating an appropriate enclosing LET. This is now fixed. + + * substitutions.lisp: + Changed the top comment and added a (:copier nil) option to the + ENVIRONMENT defstruct, as COPY-ENVIRONMENT is defined later in the + file. + + * cl-unification.system, cl-unification.asd: + Added the new system building files with more meaningful names + w.r.t. the name of the library. + + * unification.asd, unification.system: + Marked the two system building files as 'obsolete', before removing + them from the repository. The new files are prefixed by 'cl-'. + +2007-11-09 author <author(a)papadopoulou-2.ydras.offices.> * match-block.lisp: Made several changes to improve MATCH-CASE (following a note from Ivan @@ -25,7 +101,7 @@ Marked the two system building files as 'obsolete', before removing them from the repository. The new files are prefixed by 'cl-'. -2007-05-21 author <author(a)papadopoulou-2.ydras.offices.aueb.gr> +2007-05-21 author <author(a)papadopoulou-2.ydras.offices.> * ChangeLog: ChangeLog updated.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv2107 Modified Files: ACKNOWLEDGEMENTS Log Message: Added credits to a few people. Missing ones should bug the maintainer :) --- /project/cl-unification/cvsroot/cl-unification/ACKNOWLEDGEMENTS 2007/05/21 17:11:42 1.2 +++ /project/cl-unification/cvsroot/cl-unification/ACKNOWLEDGEMENTS 2008/07/13 13:33:48 1.3 @@ -1,4 +1,4 @@ -Many thanks to a lot of people are due. +A lot of pleple deserved thanks for improving CL-UNIFICATION. The Lisp NYC group has endured presentations of this code and provided feedback. @@ -6,9 +6,9 @@ The following individuals have provided feedback and (precious) bug fixes. +Boldyrev, Ivan Korablin, Vladimir V. Leuner, John +McManus, Russell Scott, Peter Werner, Norman - -

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv1615 Modified Files: README Log Message: Copyright dates updated. --- /project/cl-unification/cvsroot/cl-unification/README 2007/05/21 17:11:51 1.3 +++ /project/cl-unification/cvsroot/cl-unification/README 2008/07/13 13:30:28 1.4 @@ -1,6 +1,6 @@ CL-UNIFICATION -Marco Antoniotti (c) 2004-2007 +Marco Antoniotti (c) 2004-2008 The directory containing this file you are reading should contain the code and the documentation of the CL-UNIFICATION package.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv1112 Removed Files: unification.asd unification.system Log Message: Cleaning up. Committing in . Removed Files: unification.asd unification.system

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv589 Removed Files: templates-hierarchy-saved.lisp Log Message: Clenaing up. Committing in . Removed Files: templates-hierarchy-saved.lisp

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29979 Modified Files: INSTALLATION Log Message: Instructions updated. --- /project/cl-unification/cvsroot/cl-unification/INSTALLATION 2007/05/21 17:11:47 1.2 +++ /project/cl-unification/cvsroot/cl-unification/INSTALLATION 2008/07/13 13:20:01 1.3 @@ -5,20 +5,26 @@ Issuing - (mk:load-system "unification") + (mk:load-system "CL-UNIFICATION") or - (mk:compile-system "unification") + (mk:compile-system "CL-UNIFICATION") will make the UNIFY package available. There is also an ASDF system definition for those who use this system. +Issuing + + (asdf:oos 'asdf:load-op "CL-UNIFICATION") + +should make the library available in your environment. + If your CL implementation is ASDF-INSTALL aware, you should also be able to just say - (asdf-install:install "unification") + (asdf-install:install "CL-UNIFICATION") provided that the package is unpacked in an ASDF-INSTALL known directory.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29515 Modified Files: COPYING Log Message: Copyright dates updated. --- /project/cl-unification/cvsroot/cl-unification/COPYING 2007/05/21 17:11:45 1.3 +++ /project/cl-unification/cvsroot/cl-unification/COPYING 2008/07/13 13:17:29 1.4 @@ -1,4 +1,4 @@ -Copyright (c) 2004-2007 Marco Antoniotti +Copyright (c) 2004-2008 Marco Antoniotti All rights reserved. Permission is hereby granted, without written agreement and without

1 0

[cl-unification-cvs] CVS cl-unification/test
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification/test In directory clnet:/tmp/cvs-serv28935 Added Files: unification-tests.lisp Log Message: Added file. --- /project/cl-unification/cvsroot/cl-unification/test/unification-tests.lisp 2008/07/13 13:14:56 NONE +++ /project/cl-unification/cvsroot/cl-unification/test/unification-tests.lisp 2008/07/13 13:14:56 1.1 ;;;; -*- Mode: Lisp -*- ;;;; unification-tests.lisp -- ;;;; CL-UNIFICATION test suite. Requires Franz's util.test package. (use-package "UNIFY") (use-package "UTIL.TEST") (with-tests (:name "basic constant unification") (test t (unify:environment-p (unify 42 42))) (test-error (unify 42 12) :condition-type 'unification-failure) (test-error (unify 42 'a) :condition-type 'unification-failure) (test t (unify:environment-p (unify 'a 'a))) (test t (unify:environment-p (unify '(a s d) '(a s d)))) (test t (unify:environment-p (unify '(a (s 42) d) '(a (s 42) d)))) (test-error (unify '(a (s forty-two) d) '(a (s 42) z)) :condition-type 'unification-failure) (test t (unify:environment-p (unify #(a s d) #(a s d)))) (test t (unify:environment-p (unify #2a((a s d) (a s d)) #2a((a s d) (a s d))))) (test-error (unify #2a((a s d) (a s d)) #2a((a s d) (a 42 d))) :condition-type 'unification-failure) (test t (unify:environment-p (unify "I am a string" "I am a string"))) (test-error (unify "I am a string" "I am A string") :condition-type 'unification-failure) (test t (let ((*unify-string-case-insensitive-p* t)) (unify:environment-p (unify "I am a string" "I am A string")))) ) (with-tests (:name "variables unification") (test '(42 T) (find-variable-value '?x (unify 42 '?x)) :multiple-values t) (test '(NIL NIL) (find-variable-value '?y (unify 42 '?x)) :multiple-values t) (test '(42 T) (find-variable-value '?x (unify '?x 42)) :multiple-values t) (test '(s T) (v? '?x (unify '(a (?x 42) d) '(a (s 42) d))) :multiple-values t) (test '(s T) (v? '?x (unify '(a (?x 42) d) '(a (s 42) d))) :multiple-values t) (test '((?x 42) T) (v? '?z (unify '(a (?x 42) d) '(a ?z d))) :multiple-values t :test 'equal) (test '(NIL T) (v? '?x (unify '(a (?x 42) d) '(a (() 42) d))) :multiple-values t) (test '(NIL NIL) (v? '?variable (unify '(a (() 42) d) '(a (?x 42) d))) :multiple-values t) (test t (unify:environment-p (unify '_ '(1 2 3)))) (test t (unify:environment-p (unify '_ '(1 _ 3)))) (test t (unify:environment-p (unify '(1 2 _) '(1 _ 3)))) (test t (unify:environment-p (unify '(1 2 _) '(1 _ 3)))) (test '(2 T) (v? '?x (unify #(1 2 _) #(1 ?x 3))) :multiple-values t) (test-error (unify '(1 2 _) #(1 _ 3)) :condition-type 'unification-failure :known-failure t :fail-info "Unification on SEQUENCEs does not discriminate type.") ) (with-tests (:name "basic templates unification") (with-tests (:name "number templates unification") (test t (unify:environment-p (unify #T(number 42) 42))) (test t (unify:environment-p (unify 42 #T(number 42)))) (test t (unify:environment-p (unify 42 #T(integer 42)))) (test t (unify:environment-p (unify 42 #T(fixnum 42)))) (test t (unify:environment-p (unify 42.0 #T(real 42)))) (test t (unify:environment-p (unify #C(0 1) #T(complex #C(0 1))))) (test '(42 T) (v? '?x (unify #T(number ?x) 42)) :multiple-values t) (test-error (unify 42 #T(float 42.0)) :condition-type 'unification-failure :known-failure t :fail-info "Check rules for unification on numeric tower.") ) ) (defclass test1 () ((a :initarg :a :accessor a) (b :initarg :b :accessor b))) (with-tests (:name "advanced templates unification") (test '(a T) (v? '?x (unify #2A((1 #T(symbol ?x) 3) (_ _ _)) #2A((1 a 3) (q w e)))) :multiple-values t) (test '(#\f T) (ignore-errors (v? '?x (unify "asdfasdfasdf" #T(elt 3 ?x)))) :multiple-values t :known-failure t :fail-info "ELT templates must be fixed.") (test '(42 T) (ignore-errors (v? 'x (unify '(0 1 42 3 4 5) #T(nth 2 ?x)))) :multiple-values t :known-failure t :fail-info "NTH templates must be fixed.") (test '(2 T) (v? '?x (unify #T(test1 a #T(list 1 ?x 3 &rest) b "woot") (make-instance 'test1 :a '(1 2 3) :b "woot"))) :multiple-values t) ) (defun nested-match-cases (input) (match-case (input) ('(:a ?a :b #T(list &rest ?bs)) (loop for b in ?bs collect (match-case (b) ('(:c ?c) ?c) ('(:d ?d) ?d) (otherwise (error "error-inner"))))) (otherwise "error-outer"))) (with-tests (:name "control flow") (test "error-outer" (nested-match-cases '(:a 42 :b 33)) :test 'string=) ) ;;;; end of file -- unification-tests.lisp --

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv27424 Modified Files: substitutions.lisp templates-hierarchy.lisp unification-package.lisp variables.lisp Log Message: Some modification added. Exported symbols and reverted reader macro #T to construct template instances at read time. Added MAKE-LOAD-FORM method for templates which should fix problem with SBCL. Committing in . Modified Files: substitutions.lisp templates-hierarchy.lisp unification-package.lisp variables.lisp --- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2007/11/09 13:35:55 1.3 +++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2008/07/13 13:10:48 1.4 @@ -138,4 +138,12 @@ env)) +(defun v? (s env &optional (plain-symbol-p nil)) + (find-variable-value (if plain-symbol-p + (make-var-name s) + s) + env)) + + + ;;;; end of file -- substitutions.lisp -- --- /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2006/07/19 21:52:34 1.3 +++ /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2008/07/13 13:10:48 1.4 @@ -219,9 +219,13 @@ (defgeneric make-template (kind spec)) + ;;; Setting up the reader macro. -#|| +;;; 20080711 MA: +;;; Reverted to the old version with MAKE-LOAD-FORM added. Template +;;; objects are created at read-time. + (defun |sharp-T-reader| (stream subchar arg) (declare (ignore subchar arg)) (let ((spec (read stream t nil t))) @@ -229,12 +233,19 @@ (null (make-template nil spec)) (cons (make-template (first spec) spec)) (t (make-template spec spec))))) -||# +(defmethod make-load-form ((x template) &optional env) + (make-load-form-saving-slots x :environment env)) -;;; New version with more 'macro-like' behavior. The previous version + +#|| +;;; 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. +;;; +;;; 20080713 MA +;;; Removed because it was not working well with nested templates. +;;; Reverted to the original one plus MAKE-LOAD-FORM. (defun |sharp-T-reader| (stream subchar arg) (declare (ignore subchar arg)) @@ -244,10 +255,34 @@ (cons `(make-template ',(first spec) ',spec)) (t `(make-template ',spec ',spec))) )) - +||# (eval-when (:load-toplevel :execute) - (set-dispatch-macro-character #\# #\T #'|sharp-T-reader|)) + (set-dispatch-macro-character #\# #\T '|sharp-T-reader|)) + + +#|| Useless with the read time templates and MAKE-LOAD-FORM. + +(defun rewrite-template-spec (spec) + "Rewrites a template specification. +The rewriting simply makes sure that sub-templates are created as needed. +The result is either the SPEC itself or an appropriate call to LIST." + + (typecase spec + (atom `',spec) + (cons (destructuring-bind (head &rest tail) + spec + (case head + (quote spec) + (make-template `(make-template ,(first tail) + ,(rewrite-template-spec (second (second tail))))) + (t `(list ',head ,@(mapcar #'rewrite-template-spec tail))) + ))) + (t `',spec))) + +||# + + (defmethod make-template ((kind null) (spec symbol)) (assert (null spec) (spec) "MAKE-TEMPLATE called erroneously with ~S and ~S." kind spec) @@ -324,8 +359,8 @@ - -;;; Implementation. +;;;;=========================================================================== +;;;; Implementation. ;;; Symbol Templates. ;;; Specification is --- /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2007/05/21 12:33:15 1.3 +++ /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2008/07/13 13:10:48 1.4 @@ -6,16 +6,29 @@ This package contains all the definitions necessary for the general Common Lisp unifier to work. The package also has the \"UNIFY\" nickname.") + (:export "MAKE-TEMPLATE" "TEMPLATEP" "TEMPLATE-SPEC") + (:export "*UNIFY-STRING-CASE-INSENSITIVE-P*" "UNIFY" "FIND-VARIABLE-VALUE" + "V?" + "MAKE-EMPTY-ENVIRONMENT" - "APPLY-SUBSTITUTION") + "APPLY-SUBSTITUTION" + + "UNIFICATION-FAILURE" + "UNIFICATION-VARIABLE-UNBOUND" + ) + + (:export + "ENVIRONMENT" + "ENVIRONMENT-P") + (:export "MATCH" "MATCHING" --- /project/cl-unification/cvsroot/cl-unification/variables.lisp 2004/11/17 22:19:55 1.1.1.1 +++ /project/cl-unification/cvsroot/cl-unification/variables.lisp 2008/07/13 13:10:48 1.2 @@ -2,6 +2,11 @@ (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. + +(defun make-var-name (&optional (s (gensym)) (package *package*)) + (intern (concatenate 'string "?" (symbol-name s)) package)) + + (defun variablep (x) (and (symbolp x) (or (char= (char (symbol-name x) 0) #\?)

1 0

[cl-unification-cvs] CVS cl-unification/test
by mantoniotti 13 Jul '08

13 Jul '08

Update of /project/cl-unification/cvsroot/cl-unification/test In directory clnet:/tmp/cvs-serv27166/test Log Message: Directory /project/cl-unification/cvsroot/cl-unification/test added to the repository

1 0