Tue Mar 13 15:29:16 UTC 2012 mantoniotti@common-lisp.net * Added TIMESTAMP. Tue Mar 13 15:28:28 UTC 2012 mantoniotti@common-lisp.net * Copyright updated. Tue Mar 13 15:28:15 UTC 2012 mantoniotti@common-lisp.net * Copyright updated. Thu Jun 16 00:10:47 UTC 2011 mantoniotti@common-lisp.net * Added "CL-UNIFICATION" as package nickname to match the .asd and .system specs. Sat Apr 2 04:39:32 UTC 2011 rbrown@common-lisp.net * Use *unify-string-case-sensitive-p* consistently. Change the documentation. Sat Apr 2 04:19:09 UTC 2011 rbrown@common-lisp.net * match-block.lisp: Use &body in match-case and matchf-case so code that uses them is correctly indented by editors. Sat Apr 2 04:16:51 UTC 2011 mantoniotti@common-lisp.net * Copyright updated. Sat Apr 2 04:11:54 UTC 2011 mantoniotti@common-lisp.net * Updated copyright info and a News. Sat Apr 2 04:09:17 UTC 2011 mantoniotti@common-lisp.net * ChangeLog updated. Sat Apr 2 04:08:13 UTC 2011 mantoniotti@common-lisp.net * Remove Thumbs.db and friends Sat Apr 2 04:05:30 UTC 2011 mantoniotti@common-lisp.net * Exported a few more symbols. Sat Apr 2 04:05:18 UTC 2011 mantoniotti@common-lisp.net * Minor changes (added COPYING information and other minutiae). Sat Apr 2 04:01:24 UTC 2011 mantoniotti@common-lisp.net * Changed some environment functions and improved the DUMP-* ones. Sat Apr 2 03:51:38 UTC 2011 mantoniotti@common-lisp.net * Acknowledgements updated. Sat Apr 2 03:50:19 UTC 2011 rbrown@common-lisp.net * Delete trailing whitespace. In lambda-list-parsing.lisp this fixes a bug with ~@ format directives. Sat Apr 2 02:51:32 UTC 2011 rbrown@common-lisp.net * unifier.lisp: Allow vectors to unify with sequence templates. test/unification-tests.lisp: new test to verify the change Sat Apr 2 02:49:30 UTC 2011 rbrown@common-lisp.net * Add entry for cl-unification-test.asd. Sat Apr 2 02:47:50 UTC 2011 rbrown@common-lisp.net * Add cl-unification-test.asd Make (asdf:test-system 'cl-unification) work. Sat Apr 2 02:37:58 UTC 2011 rbrown@common-lisp.net * Make sure that classes referenced in #T forms are defined before the forms are read. This fixes compilation of file unification-tests.lisp. Tue Mar 29 23:22:33 UTC 2011 mantoniotti@common-lisp.net * Copyright dates updated. Tue Mar 29 23:20:53 UTC 2011 mantoniotti@common-lisp.net * ChangeLog updated. Tue Mar 29 22:59:37 UTC 2011 mantoniotti@common-lisp.net * Added debugging functions DUMP-FRAME and DUMP-ENVIRONMENT. Tue Jun 15 03:21:37 UTC 2010 pix@kepibu.org * Pull variable binding out of %match-expander I'd like to tell you this is part of a plan to simplify %match-expander, but in all honesty, the only reason I'm doing it is because I found myself thinking with-unification-variables would be a handy macro while working on a private extension to cl-unification, and I didn't want to duplicate the code. Sun Feb 7 08:42:39 UTC 2010 pix@kepibu.org * Marginally more straightforward? Sun Feb 7 07:40:23 UTC 2010 pix@kepibu.org * Declare ftype of find-variable-value and v? properly Sun Feb 7 07:33:38 UTC 2010 pix@kepibu.org * Fix export of lib-dependent symbols Sun Feb 7 07:30:06 UTC 2010 pix@kepibu.org * Specialization on the second arg of print-object is not allowed diff -rN -u old-cl-unification-1/ACKNOWLEDGEMENTS new-cl-unification-1/ACKNOWLEDGEMENTS --- old-cl-unification-1/ACKNOWLEDGEMENTS 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/ACKNOWLEDGEMENTS 2013-07-24 23:03:06.000000000 +0000 @@ -7,6 +7,7 @@ fixes. Boldyrev, Ivan +Brown, Robert Korablin, Vladimir V. Leuner, John McManus, Russell diff -rN -u old-cl-unification-1/COPYING new-cl-unification-1/COPYING --- old-cl-unification-1/COPYING 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/COPYING 2013-07-24 23:03:06.000000000 +0000 @@ -1,4 +1,4 @@ -Copyright (c) 2004-2009 Marco Antoniotti +Copyright (c) 2004-2012 Marco Antoniotti All rights reserved. Permission is hereby granted, without written agreement and without diff -rN -u old-cl-unification-1/ChangeLog new-cl-unification-1/ChangeLog --- old-cl-unification-1/ChangeLog 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/ChangeLog 2013-07-24 23:03:06.000000000 +0000 @@ -1,3 +1,103 @@ +2011-03-28 Robert Brown + + * match-block.lisp: Use &body in match-case and matchf-case so + code that uses them is correctly indented by editors. + +2011-02-27 author + + * .cvsignore: Updated. + + * docs/html/images/Thumbs.db, docs/html/images/Thumbs.db:encryptable: + Removed Files: + Thumbs.db Thumbs.db:encryptable + +2011-02-26 author + + * .cvsignore: Updated. + + * variables.lisp, unifier.lisp: + Minor changes (added COPYING information and other minutiae). + + * unification-package.lisp: Exported a few more symbols. + + * templates-hierarchy.lisp: + Minor changes (added COPYING information and other minutiae). + + * substitutions.lisp: + Changed some environment functions and improved the DUMP-* ones. + + * match-block.lisp, lambda-list-parsing.lisp, cl-unification.system, cl-unification.asd, cl-unification-lib.asd, apply-substitution.lisp: + Minor changes (added COPYING information and other minutiae). + + * ACKNOWLEDGEMENTS: Acknowledgements updated. + +2011-02-24 author + + * ChangeLog, apply-substitution.lisp, cl-unification.system, lambda-list-parsing.lisp, lib-dependent/cl-ppcre-template.lisp, match-block.lisp, templates-hierarchy.lisp, unifier.lisp: + Delete trailing whitespace. In lambda-list-parsing.lisp this fixes a bug + with ~@ format directives. + + * ChangeLog, test/unification-tests.lisp, unifier.lisp: + unifier.lisp: Allow vectors to unify with sequence templates. + test/unification-tests.lisp: new test to verify the change + +2011-02-24 Robert Brown + + * lambda-list-parsing.lisp: Delete trailing whitespace that turned + ~@ into a bogus format directive by converting it into + ~@ + + * unifier.lisp, apply-substitution.lisp, cl-unification.system + * match-block.lisp, templates-hierarchy.lisp, unifier.lisp + * lib-dependent/cl-ppcre-template.lisp: delete trailing whitespace + +2011-02-24 Robert Brown + + * unifier.lisp: Allow vectors to unify with sequence templates. + * test/unification-tests.lisp: new test to verify the change + +2011-02-16 Robert Brown + + * cl-unification.asd: Add support for asdf:test-system. + + * cl-unification-test.asd: File added. + +2011-01-18 author + + * 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 + + * 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 * lib-dependent/cl-ppcre-template.asd: Initial checkin. diff -rN -u old-cl-unification-1/README new-cl-unification-1/README --- old-cl-unification-1/README 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/README 2013-07-24 23:03:06.000000000 +0000 @@ -1,6 +1,6 @@ CL-UNIFICATION -Marco Antoniotti (c) 2004-2008 +Marco Antoniotti (c) 2004-2011 The directory containing this file you are reading should contain the code and the documentation of the CL-UNIFICATION package. diff -rN -u old-cl-unification-1/TIMESTAMP new-cl-unification-1/TIMESTAMP --- old-cl-unification-1/TIMESTAMP 1970-01-01 00:00:00.000000000 +0000 +++ new-cl-unification-1/TIMESTAMP 2013-07-24 23:03:06.000000000 +0000 @@ -0,0 +1 @@ +20120116 diff -rN -u old-cl-unification-1/apply-substitution.lisp new-cl-unification-1/apply-substitution.lisp --- old-cl-unification-1/apply-substitution.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/apply-substitution.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -1,8 +1,10 @@ -;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Lisp -*- -;;; substitutions.lisp -;;; General CL structures unifier. -;;; Substitution definitions. +;;;; apply-substitutions.lisp -- +;;;; General CL structures unifier. +;;;; Substitution definitions. +;;;; +;;;; See the file COPYING for copyright and licensing information. (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. @@ -70,8 +72,8 @@ finally (return (make-frame result-bindings))) into frames finally (return (make-environment :frames frames)))) - - + + ;;; ground-term -- @@ -80,4 +82,4 @@ (apply-substitution substitution term)) -;;; end of file -- apply-substitutions.lisp -- +;;;; end of file -- apply-substitutions.lisp -- diff -rN -u old-cl-unification-1/cl-unification-lib.asd new-cl-unification-1/cl-unification-lib.asd --- old-cl-unification-1/cl-unification-lib.asd 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/cl-unification-lib.asd 2013-07-24 23:03:06.000000000 +0000 @@ -2,6 +2,8 @@ ;;;; cl-unification-lib.asd -- ;;;; ASDF system file. +;;;; +;;;; See file COPYING for copyright and licensing information. (asdf:defsystem :cl-unification-lib :author "Marco Antoniotti" diff -rN -u old-cl-unification-1/cl-unification-test.asd new-cl-unification-1/cl-unification-test.asd --- old-cl-unification-1/cl-unification-test.asd 1970-01-01 00:00:00.000000000 +0000 +++ new-cl-unification-1/cl-unification-test.asd 2013-07-24 23:03:06.000000000 +0000 @@ -0,0 +1,31 @@ +;;;; cl-unification-test.asd + + +(in-package #:asdf) + +;; Tests implemented using the ptester framework are run at *load* time, so +;; we tell ASDF that loading a file containing ptester code is never done. +;; This causes ASDF to run all the tests whenever ASDF:LOAD-SYSTEM or +;; ASDF:TEST-SYSTEM is called with argument CL-UNIFICATION-TEST. + +(defclass ptester-source-file (cl-source-file) + () + (:documentation "A Common Lisp source file containing ptester code.")) + +(defmethod operation-done-p ((operation load-op) (component ptester-source-file)) + nil) + + +(in-package #:common-lisp-user) + +(defpackage #:cl-unification-test-system + (:use #:common-lisp #:asdf)) + +(in-package #:cl-unification-test-system) + +(defsystem #:cl-unification-test + :depends-on (:cl-unification :ptester) + :components + ((:module "test" + :components + ((:ptester-source-file "unification-tests"))))) diff -rN -u old-cl-unification-1/cl-unification.asd new-cl-unification-1/cl-unification.asd --- old-cl-unification-1/cl-unification.asd 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/cl-unification.asd 2013-07-24 23:03:06.000000000 +0000 @@ -1,10 +1,8 @@ ;;;; -*- Mode: Lisp -*- - ;;;; cl-unification.asd -- ;;;; ASDF system file. -;;;;=========================================================================== -;;;; Simple stuff that should be built in ASDF. +;;;; See file COPYING for copyright licensing information. (defpackage "CL-UNIFICATION-SYSTEM" (:use "CL" "ASDF")) @@ -13,12 +11,23 @@ (when (asdf:find-system 'asdf-system-connections nil) (asdf:oos 'asdf:load-op 'asdf-system-connections)) -(defclass asdf-system-definition-file (asdf:cl-source-file) ()) -(defmethod source-file-type ((c asdf-system-definition-file) (s module)) "asd") - +(defclass load-only-file (cl-source-file) + ((last-loaded :accessor load-date :initform nil))) +(defmethod operation-done-p ((op compile-op) (component load-only-file)) + t) +(defmethod perform :around ((op compile-op) (component load-only-file)) + nil) +(defmethod operation-done-p ((op load-op) (component load-only-file)) + (and (load-date component) + (>= (load-date component) (file-write-date (component-pathname component))))) +(defmethod perform ((op load-op) (component load-only-file)) + (prog1 (load (component-pathname component)) + (setf (load-date component) + (file-write-date (component-pathname component))))) (asdf:defsystem :cl-unification :author "Marco Antoniotti" + :in-order-to ((test-op (test-op :cl-unification-test))) :serial t :components ((:file "unification-package") (:file "variables") @@ -28,29 +37,20 @@ (:file "template-reader") (:file "unifier") (:file "match-block") - (:file "apply-substitution") - #+asdf-with-optional-dependencies - (:module "lib-dependent" - :pathname "lib-dependent" - :depends-on ("templates-hierarchy" "unifier") - :components ((:file "cl-ppcre-template" - :depends-on (cl-ppcre)) - )) - #-asdf-with-optional-dependencies - (asdf-system-definition-file - "cl-unification-lib") - )) + (:file "apply-substitution"))) #+asdf-system-connections (asdf:defsystem-connection cl-unification+cl-ppcre :requires (:cl-ppcre :cl-unification) - :components ((:module "lib-dependent" + :components ((:load-only-file "unification-package") + (:module "lib-dependent" :components ((:file "cl-ppcre-template"))))) #+asdf-system-connections (asdf:defsystem-connection cl-unification+named-readtables :requires (:cl-unification :named-readtables) - :components ((:module "lib-dependent" + :components ((:load-only-file "unification-package") + (:module "lib-dependent" :components ((:file "named-readtable"))))) ;;;; end of file -- cl-unification.asd -- diff -rN -u old-cl-unification-1/cl-unification.system new-cl-unification-1/cl-unification.system --- old-cl-unification-1/cl-unification.system 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/cl-unification.system 2013-07-24 23:03:06.000000000 +0000 @@ -3,6 +3,8 @@ ;;;; cl-unification.system -- ;;;; MK:DEFSYSTEM system file. +;;;; See file COPYING for copyright licensing information. + (mk:defsystem "CL-UNIFICATION" :source-extension "lisp" :components ("unification-package" @@ -20,5 +22,5 @@ ) )) )) - + ;;; end of file -- cl-unification.system -- diff -rN -u old-cl-unification-1/docs/html/control-flow.html new-cl-unification-1/docs/html/control-flow.html --- old-cl-unification-1/docs/html/control-flow.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/control-flow.html 2013-07-24 23:03:06.000000000 +0000 @@ -208,7 +208,7 @@
-

News

+ +
@@ -233,7 +234,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/dictionary.html new-cl-unification-1/docs/html/dictionary.html --- old-cl-unification-1/docs/html/dictionary.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/dictionary.html 2013-07-24 23:03:06.000000000 +0000 @@ -279,7 +279,7 @@ @@ -339,7 +339,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/downloads.html new-cl-unification-1/docs/html/downloads.html --- old-cl-unification-1/docs/html/downloads.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/downloads.html 2013-07-24 23:03:06.000000000 +0000 @@ -97,7 +97,7 @@
-

News

+
@@ -124,7 +124,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/index.html new-cl-unification-1/docs/html/index.html --- old-cl-unification-1/docs/html/index.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/index.html 2013-07-24 23:03:06.000000000 +0000 @@ -308,7 +308,7 @@ + @@ -109,7 +110,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/mailing-lists.html new-cl-unification-1/docs/html/mailing-lists.html --- old-cl-unification-1/docs/html/mailing-lists.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/mailing-lists.html 2013-07-24 23:03:06.000000000 +0000 @@ -55,7 +55,7 @@ @@ -117,7 +117,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/string-template-class.html new-cl-unification-1/docs/html/string-template-class.html --- old-cl-unification-1/docs/html/string-template-class.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/string-template-class.html 2013-07-24 23:03:06.000000000 +0000 @@ -122,7 +122,7 @@

Affected By:

-

The value of the variable *UNIFY-STRING-CASE-INSENSITIVE-P*.

+

The value of the variable *UNIFY-STRING-CASE-SENSITIVE-P*.

Exceptional Situations:

diff -rN -u old-cl-unification-1/docs/html/templates.html new-cl-unification-1/docs/html/templates.html --- old-cl-unification-1/docs/html/templates.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/templates.html 2013-07-24 23:03:06.000000000 +0000 @@ -173,7 +173,7 @@
-

News

+
@@ -198,7 +198,7 @@
- © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
diff -rN -u old-cl-unification-1/docs/html/unification-dictionary.html new-cl-unification-1/docs/html/unification-dictionary.html --- old-cl-unification-1/docs/html/unification-dictionary.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/unification-dictionary.html 2013-07-24 23:03:06.000000000 +0000 @@ -38,7 +38,7 @@
  • Package CL.EXT.DACF.UNIFICATION
  • Generic function UNIFY -
  • Variable *UNIFY-STRING-CASE-INSENSITIVE* +
  • Variable *UNIFY-STRING-CASE-SENSITIVE*
  • Class TEMPLATE
  • Class EXPRESSION-TEMPLATE @@ -106,7 +106,7 @@
    -

    News

    +
    @@ -133,7 +133,7 @@
    - © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
    diff -rN -u old-cl-unification-1/docs/html/unify-function.html new-cl-unification-1/docs/html/unify-function.html --- old-cl-unification-1/docs/html/unify-function.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/unify-function.html 2013-07-24 23:03:06.000000000 +0000 @@ -163,7 +163,7 @@

    Two strings unify only is they are "equal", under the following - condition. If the variable *UNIFY-STRING-CASE-INSENSITIVE-P* is NIL + condition. If the variable *UNIFY-STRING-CASE-SENSITIVE-P* is T (the default) then the two strings s1 and s2 are compared using STRING=, otherwise they are compared using STRING-EQUAL.

    @@ -335,7 +335,7 @@

    See Also:

    MAKE-EMPTY-ENVIRONMENT, UNIFICATION-FAILURE, - *UNIFY-STRING-CASE-INSENSITIVE-P*, OCCURS-IN-P, + *UNIFY-STRING-CASE-SENSITIVE-P*, OCCURS-IN-P, *OCCURENCE-CHECK-P*.

    Notes:

    diff -rN -u old-cl-unification-1/docs/html/unifying-substitutions.html new-cl-unification-1/docs/html/unifying-substitutions.html --- old-cl-unification-1/docs/html/unifying-substitutions.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/unifying-substitutions.html 2013-07-24 23:03:06.000000000 +0000 @@ -162,7 +162,7 @@
    -

    News

    +
    @@ -187,7 +187,7 @@
    - © 2003-2004, Marco Antoniotti, all rights reserved. + © 2003-2011, Marco Antoniotti, all rights reserved.
    diff -rN -u old-cl-unification-1/docs/html/usci-variable.html new-cl-unification-1/docs/html/usci-variable.html --- old-cl-unification-1/docs/html/usci-variable.html 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/docs/html/usci-variable.html 2013-07-24 23:03:06.000000000 +0000 @@ -1,6 +1,6 @@ - CL Unification: Variable *UNIFY-STRING-CASE-INSENSITIVE-P* + CL Unification: Variable *UNIFY-STRING-CASE-SENSITIVE-P* @@ -11,7 +11,7 @@
    - CL Unification: Variable *UNIFY-STRING-CASE-INSENSITIVE-P* + CL Unification: Variable *UNIFY-STRING-CASE-SENSITIVE-P*
    Home | Previous @@ -33,7 +33,7 @@
    -

    Variable *UNIFY-STRING-CASE-INSENSITIVE-P*

    +

    Variable *UNIFY-STRING-CASE-SENSITIVE-P*

    Package:

    @@ -56,9 +56,9 @@

    Description:

    -

    The value of *UNIFY-STRING-CASE-INSENSITIVE-P* controls the +

    The value of *UNIFY-STRING-CASE-SENSITIVE-P* controls the behavior of the UNIFY method with signature (string string). - If NIL (the default), the method will use STRING= to test for + If T (the default), the method will use STRING= to test for equality of the two strings. Otherwise, the UNIFY method will use STRING-EQUAL.

    Affected By:

    diff -rN -u old-cl-unification-1/lambda-list-parsing.lisp new-cl-unification-1/lambda-list-parsing.lisp --- old-cl-unification-1/lambda-list-parsing.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/lambda-list-parsing.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -2,6 +2,8 @@ ;;; lambda-list-parsing.lisp -- +;;;; See file COPYING for copyright licensing information. + (in-package "UNIFY") @@ -49,7 +51,7 @@ ) ;;; The next function is really implementation-dependent, give the -;;; definition of LAMBDA-LIST-KEYWORDS +;;; definition of LAMBDA-LIST-KEYWORDS. (define-condition lambda-list-parsing-error (program-error) @@ -90,7 +92,7 @@ (&aux (parse-auxiliary-arguments (rest lambda-list))) (&rest (parse-rest-arguments (rest lambda-list))) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -112,7 +114,7 @@ (&aux (parse-auxiliary-arguments (rest lambda-list))) (&rest (parse-rest-arguments (rest lambda-list))) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -139,7 +141,7 @@ (error 'lambda-list-parsing-error :item head)) (skip-until-next-lambda-list-keyword (rest lambda-list))) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -165,7 +167,7 @@ (&aux (parse-auxiliary-arguments (rest lambda-list))) (&rest (error 'lambda-list-parsing-error :item head)) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -187,7 +189,7 @@ (&aux (error 'lambda-list-parsing-error :item head)) (&rest (error 'lambda-list-parsing-error :item head)) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -210,7 +212,7 @@ (&aux (parse-auxiliary-arguments (rest lambda-list))) (&rest (parse-rest-arguments (rest lambda-list))) (otherwise - (warn "Keyword ~A is implementation dependent.~@ + (warn "Keyword ~A is implementation dependent.~@ The parsing may not work properly." head) (skip-until-next-lambda-list-keyword (rest lambda-list)) @@ -277,7 +279,7 @@ (symbol (make-key-lambda-var-info :name var :type init-value-type :default-value init-value)) - + (cons (destructuring-bind (kwd var) var (etypecase var diff -rN -u old-cl-unification-1/lib-dependent/cl-ppcre-template.lisp new-cl-unification-1/lib-dependent/cl-ppcre-template.lisp --- old-cl-unification-1/lib-dependent/cl-ppcre-template.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/lib-dependent/cl-ppcre-template.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -144,6 +144,6 @@ &optional (env (make-empty-environment)) &key (start 0) end &allow-other-keys) (unify re-t s env :start start :end end)) - + ;;;; end of file -- cl-ppcre-template.lisp -- diff -rN -u old-cl-unification-1/match-block.lisp new-cl-unification-1/match-block.lisp --- old-cl-unification-1/match-block.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/match-block.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -3,6 +3,8 @@ ;;;; match-block.lisp -- ;;;; Various macros built on top of the unifier: MATCH, MATCHING and MATCH-CASE. +;;;; See file COPYING for copyright licensing information. + (in-package "UNIFY") (defun clean-unify-var-name (v) @@ -10,6 +12,15 @@ (intern (subseq (symbol-name v) 1) (symbol-package v))) +(defmacro with-unification-variables ((&rest variables) environment &body body) + "Execute body with variables bound to their values in environment." + (flet ((variable-bindings (v) + `((,v (find-variable-value ',v ,environment)) + (,(clean-unify-var-name v) ,v)))) + `(let* ,(mapcan #'variable-bindings variables) + (declare (ignorable ,@(mapcar #'clean-unify-var-name variables))) + ,@body))) + (defun %match-expander (template-munger clause-munger clauses &key default named environment errorp error-form keyform) "A rather hairy internal function which handles expansion for all the MATCH* macros. @@ -81,18 +92,14 @@ (make-instance 'list-template :spec (cons 'list template))) (t template))) - (bind-variable (v) - `((,v (find-variable-value ',v ,match-environment)) - (,(clean-unify-var-name v) ,v))) (expand-clause (clause) (destructuring-bind (template object &rest body) - clause + (munge-clause clause) (let* ((template (ensure-template template)) (variables (collect-template-vars template))) `((setf (values ,match-environment ,match-error) (unify* ,template ,object (make-expanded-environment ,base-environment))) - (let* ,(mapcan #'bind-variable variables) - (declare (ignorable ,@variables ,@(mapcar #'clean-unify-var-name variables))) + (with-unification-variables ,variables ,match-environment ,@body))))) (munge-clause (clause) (ecase clause-munger @@ -112,7 +119,7 @@ (declare (dynamic-extent ,match-environment ,base-environment) (ignorable ,case-keyform)) (cond - ,@(mapcar (lambda (c) (expand-clause (munge-clause c))) match-clauses) + ,@(mapcar #'expand-clause match-clauses) ,@(when errorp `((,errorp ,(or error-form `(error ,match-error))))) ,@(when default-clauses `((t ,@(cdar default-clauses)))) ,@(when default `((t ,default)))))))))) diff -rN -u old-cl-unification-1/substitutions.lisp new-cl-unification-1/substitutions.lisp --- old-cl-unification-1/substitutions.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/substitutions.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -4,6 +4,8 @@ ;;;; General CL structures unifier. ;;;; Substitution definitions. Mostly a rehash of the usual SICP stuff. +;;;; See file COPYING for copyright licensing information. + (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. ;;;--------------------------------------------------------------------------- @@ -113,10 +115,23 @@ (make-environment :frames (list (make-frame)))) (defun copy-environment (env) + (declare (type environment env)) (make-environment :frames (copy-list (environment-frames env)))) -(defun make-shared-environment (env) - (make-environment :frames (environment-frames env))) +(defun make-shared-environment (env &optional (pushp nil)) + (declare (type environment env)) + (make-environment :frames (if pushp + (cons (make-frame) (environment-frames env)) + (environment-frames env)))) + +(defun push-frame (env) + (declare (type environment env)) + (push (make-frame) (environment-frames env))) + +(defun pop-frame (env) + (declare (type environment env)) + (pop (environment-frames env))) + (defun make-expanded-environment (base-env) (make-environment :frames (cons (make-frame) (environment-frames base-env)))) @@ -166,9 +181,11 @@ (declaim (inline v?)) -(declaim (ftype (function (symbol environment &optional boolean) +(declaim (ftype (function (symbol &optional environment boolean) + (values t boolean)) + find-variable-value) + (ftype (function (symbol environment &optional boolean) (values t boolean)) - find-variable-value v?)) (defun v? (s env &optional (plain-symbol-p nil)) @@ -185,6 +202,25 @@ (mapcan #'frame-values (environment-frames env))) +;;;--------------------------------------------------------------------------- +;;; Simple debugging. +(defun dump-frame (f &optional (out *standard-output*)) + (declare (type frame f)) + (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)) + (if (empty-environment-p env) + (format out ">>> Empty unify environment ~S.~%" env) + (loop initially (format out ">>> Dumping unify environment ~S.~%" env) + for fr in (environment-frames env) + for fr-n downfrom (list-length (environment-frames env)) + do (format out ">>> Frame ~D:~%" fr-n) + do (dump-frame fr out) + do (terpri out) + ))) ;;;; end of file -- substitutions.lisp -- diff -rN -u old-cl-unification-1/templates-hierarchy.lisp new-cl-unification-1/templates-hierarchy.lisp --- old-cl-unification-1/templates-hierarchy.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/templates-hierarchy.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -2,6 +2,8 @@ ;;;; templates-hierarchy.lisp -- +;;;; See file COPYING for copyright licensing information. + (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. ;;; Templates. @@ -106,7 +108,7 @@ (:method ((x t)) nil)) -(defmethod print-object ((template template) (stream stream)) +(defmethod print-object ((template template) stream) (format stream "#T~S" (template-spec template))) diff -rN -u old-cl-unification-1/test/unification-tests.lisp new-cl-unification-1/test/unification-tests.lisp --- old-cl-unification-1/test/unification-tests.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/test/unification-tests.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -1,13 +1,13 @@ ;;;; -*- Mode: Lisp -*- ;;;; unification-tests.lisp -- -;;;; CL-UNIFICATION test suite. Requires Franz's util.test package on -;;;; allegro or the ptester compatibility library on other lisps. -#+allegro (require :tester) -#-allegro (asdf:oos 'asdf:load-op :ptester) +;;;; CL-UNIFICATION test suite. Requires ptester, the public version of +;;;; Franz's util.test package. + +(defpackage "IT.UNIMIB.DISCO.MA.CL.EXT.DACF.UNIFICATION.TESTS" + (:use "CL" "UNIFY" "PTESTER") + (:nicknames "CL.EXT.DACF.UNIFICATION.TESTS" "UNIFY.TESTS")) -(cl:defpackage "UNIFY.TESTS" - (:use "CL" "UNIFY" #+allegro "UTIL.TEST" #-allegro "PTESTER")) (in-package "UNIFY.TESTS") ;; nil seems like a lousy default for this @@ -43,7 +43,7 @@ (test-error (unify "I am a string" "I am A string") :condition-type 'unification-failure) - (test t (let ((*unify-string-case-insensitive-p* t)) + (test t (let ((*unify-string-case-sensitive-p* nil)) (unify:environment-p (unify "I am a string" "I am A string")))) ) @@ -102,6 +102,8 @@ (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 '(42 T) (v? '?x (unify #(0 1 42 3 4 5) #T(sequence 0 1 ?x 3 4 5))) + :multiple-values t) (test-error (unify 42 #T(float 42.0)) :condition-type 'unification-failure @@ -111,6 +113,8 @@ ) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defclass test1 () ((a :initarg :a :accessor a) (b :initarg :b :accessor b))) @@ -118,6 +122,8 @@ (defstruct s-root a) (defstruct (s-child (:include s-root)) b) +) + (with-tests (:name "advanced templates unification") (test '(a T) (v? '?x (unify #2A((1 #T(symbol ?x) 3) (_ _ _)) diff -rN -u old-cl-unification-1/unification-package.lisp new-cl-unification-1/unification-package.lisp --- old-cl-unification-1/unification-package.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/unification-package.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -3,12 +3,12 @@ ;;;; unification-package.lisp -- ;;;; Package definition for the CL-UNIFICATION library. ;;;; -;;;; Copyright (c) 2004-2009 Marco Antoniotti -;;;; See file COPYING for licensing information. +;;;; Copyright (c) 2004-2011 Marco Antoniotti +;;;; See file COPYING for copyright licensing information. (defpackage "IT.UNIMIB.DISCO.MA.CL.EXT.DACF.UNIFICATION" (:use "CL") - (:nicknames "CL.EXT.DACF.UNIFICATION" "UNIFY" "unify") + (:nicknames "CL.EXT.DACF.UNIFICATION" "UNIFY" "unify" "CL-UNIFICATION") (:documentation "The CL.EXT.DACF.UNIFICATION Package. This package contains all the definitions necessary for the general @@ -16,18 +16,9 @@ The package also has the \"UNIFY\" nickname.") (:export - "ENABLE-TEMPLATE-READER" - "MAKE-TEMPLATE" - "TEMPLATEP" - "TEMPLATE-SPEC") - - (:export - "*UNIFY-STRING-CASE-INSENSITIVE-P*" + "*UNIFY-STRING-CASE-SENSITIVE-P*" "UNIFY" - "FIND-VARIABLE-VALUE" - "V?" - "MAKE-EMPTY-ENVIRONMENT" "APPLY-SUBSTITUTION" "UNIFICATION-FAILURE" @@ -36,7 +27,29 @@ (:export "ENVIRONMENT" - "ENVIRONMENT-P") + "ENVIRONMENT-P" + "MAKE-EMPTY-ENVIRONMENT" + "EMPTY-ENVIRONMENT-P" + "MAKE-SHARED-ENVIRONMENT" + "COPY-ENVIRONMENT" + + "PUSH-FRAME" + "POP-FRAME" + + "BINDING-VARIABLE" + "BINDING-VALUE" + + "EXTEND-ENVIRONMENT" + "FILL-ENVIRONMENT" + "FILL-ENVIRONMENT*" + + "FIND-VARIABLE-VALUE" + "V?" + + "NEW-VAR" + "VARIABLEP" + "VARIABLE-ANY-P" + ) (:export "MATCH" @@ -55,6 +68,15 @@ "UNIFY-EQUATIONS" "UNIFY-EQUATIONS*") + (:export + "ENABLE-TEMPLATE-READER" + "MAKE-TEMPLATE" + "TEMPLATEP" + "TEMPLATE-SPEC" + + "COLLECT-TEMPLATE-VARS" + ) + #+cl-ppcre (:export "REGULAR-EXPRESSION" diff -rN -u old-cl-unification-1/unifier.lisp new-cl-unification-1/unifier.lisp --- old-cl-unification-1/unifier.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/unifier.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -3,6 +3,8 @@ ;;; unifier.lisp ;;; General CL structures unifier. +;;;; See file COPYING for copyright licensing information. + (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. (defgeneric unify (a b &optional env &key &allow-other-keys) @@ -91,7 +93,7 @@ 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. +*UNIFY-STRING-CASE-SENSITIVE-P*, which defaults to T. 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)) @@ -113,7 +115,7 @@ 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) is made according to the value of the variable -*UNIFY-STRING-CASE-INSENSITIVE-P*, which defaults to NIL. +*UNIFY-STRING-CASE-SENSITIVE-P*, which defaults to T. 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 (string= a b)) @@ -440,7 +442,7 @@ :key-variable-test #'valid-template-p :rest-variable-test #'valid-template-p ) - + (let* ((n-vars (list-length vars)) (n-optionals (list-length optionals)) (env (unify (subseq a 0 (min ll (list-length vars))) @@ -476,7 +478,7 @@ :format-arguments (list a b))) -(defmethod unify ((a vector) (b vector-template) +(defmethod unify ((a vector) (b sequence-template) &optional (env (make-empty-environment)) &key &allow-other-keys) (let ((template-lambda-list (sequence-template-lambda-list b)) @@ -489,7 +491,7 @@ :key-variable-test #'valid-template-p :rest-variable-test #'valid-template-p ) - + (let ((n-vars (list-length vars)) (n-optionals (list-length optionals)) ) @@ -936,7 +938,7 @@ ;; 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) diff -rN -u old-cl-unification-1/variables.lisp new-cl-unification-1/variables.lisp --- old-cl-unification-1/variables.lisp 2013-07-24 23:03:06.000000000 +0000 +++ new-cl-unification-1/variables.lisp 2013-07-24 23:03:06.000000000 +0000 @@ -1,10 +1,19 @@ -;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Lisp -*- + +;;;; variables.lisp -- + +;;;; See file COPYING for copyright licensing information. (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. -(defun make-var-name (&optional (s (gensym "UNIFVAR-")) (package *package*)) - (intern (concatenate 'string "?" (symbol-name s)) package)) +(defun make-var-name (&optional (s (gensym "UV_")) (package *package*)) + (declare (type (or string symbol character) s)) + (intern (concatenate 'string "?" (string s)) package)) + + +(eval-when (:load-toplevel :execute) + (setf (fdefinition 'new-var) #'make-var-name)) (defun variablep (x)