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 ~@<newline> 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

Fri Feb 5 09:30:48 UTC 2010 pix@kepibu.org

* Whoops. Typo in test.

Fri Feb 5 09:04:00 UTC 2010 pix@kepibu.org

* Create a named-readtable if the named-readtables library is also loaded

Because (in-readtable ...) is a beautiful thing.

Fri Feb 5 09:02:42 UTC 2010 pix@kepibu.org

* Add (enable-template-reader), so it is easy to turn on the template reader

Useful when there are conflicts on #T, such as with closure-html.

Fri Feb 5 08:58:50 UTC 2010 pix@kepibu.org

* Export new MATCH* macros.

Fri Feb 5 03:21:40 UTC 2010 pix@kepibu.org

* Unified docstrings.

Thu Feb 4 07:32:18 UTC 2010 pix@kepibu.org

* Merge all MATCH* macros into a single, unified expansion function

And, because it's now trivial, add MATCH-COND, MATCHF-COND, MATCH-ECASE, and

MATCHF-ECASE.

Still to do: Merge documentation of functions so there's less copy-pasta in the

documentation strings.

Thu Feb 4 07:31:47 UTC 2010 pix@kepibu.org

* Duplicate nested match-case tests for matchf-case.

Thu Feb 4 07:20:04 UTC 2010 pix@kepibu.org

* Make "inner-error" and "outer-error" proper conditions.

Wed Feb 3 09:56:58 UTC 2010 pix@kepibu.org

* Make condition printable, for easier manually stepping through tests.

Wed Feb 3 09:53:59 UTC 2010 pix@kepibu.org

* These are no longer failures. Woo!

Mon Jan 25 07:38:54 UTC 2010 pix@kepibu.org

* Moar tests!

Mon Jan 25 07:38:27 UTC 2010 pix@kepibu.org

* Consider unexpected errors as test failures

...why is this not default behavior?

Mon Jan 25 07:03:27 UTC 2010 pix@kepibu.org

* (cond (a b) (c d) nil) isn't really valid

Sat Jan 23 00:53:33 UTC 2010 pix@kepibu.org

* How did .clbuild-skip-update even get /in/ the repo?

Sat Jan 23 00:31:24 UTC 2010 pix@kepibu.org

* Make tests file loadable

Sat Jan 23 00:19:32 UTC 2010 pix@kepibu.org

* DTRT when asdf-system-connections is available

Thu Jan 21 01:56:47 UTC 2010 pix@kepibu.org

* Rather than a new UNIFY** function, make UNIFY* work that way

Let errors which are not UNIFICATION-FAILUREs find their way out of UNIFY*.

Wed Jan 20 08:28:50 UTC 2010 pix@kepibu.org

* Can't IN-PACKAGE without a previous DEFPACKAGE.

Wed Jan 20 08:27:09 UTC 2010 pix@kepibu.org

* Handle :case-sensitive properly

If the first clause doesn't match due to mismatched case, it would

roll down to the second clause, causing case-differing strings to

erroneously match. By checking for case again, we can avoid this.

Note, however, that this does not fix the similar but unrelated

inconsistent usage of *unify-string-case-sensitive-p* and

*unify-string-case-insensitive-p* (the former being used in the code

and the latter appearing in documentation). That bug will remain

until the canonical form is decided upon.

Wed Jan 20 08:09:59 UTC 2010 pix@kepibu.org

* Fix typo (connot -> cannot)

Fri Jan 15 08:55:05 UTC 2010 pix@kepibu.org

* Redefine MATCH-CASE in terms of MATCHING

This both greatly simplifies the MATCH-CASE macro as well as its expansion.

HOWEVER, this version is *NOT* 100% compatible with the previous version.

Specifically, UNIFICATION-FAILUREs signalled from within clause-forms will /not/

cause the next unification clause to be attempted, but will instead propogate

outward as the -case name suggests they should.

That is,

(ignore-errors

(match-case ("foo")

("foo" (error 'unification-failure ...))

(t :default)))

=> :default ;; before patch

=> nil, #<unification-failure> ;; after patch

Fri Jan 15 08:49:26 UTC 2010 pix@kepibu.org

* Only use one variable to store the unification environment in MATCHING

Because of the way MATCHING expands, and what UNIFY* returns, each

(setf #:env (unify* ...))

call will do one of two things: it will set #:env to NIL or it will set #:env to

an ENVIRONMENT structure.

If #:env is set to NIL--the same value it entered the (setf) with!--the COND

will continue on to the next clause.

If #:env is set to an ENVIRONMENT structure, none of the remaining (setf)

clauses will be evaluated.

Thus, because the variable will only ever be set to a non-nil value once, this

should be perfectly safe.

Fri Jan 15 07:59:02 UTC 2010 pix@kepibu.org

* Make MATCHING agree with MATCH[F][-CASE] about the conditions of failure

Rather than skipping to the next clause on any error, UNIFICATION-FAILUREs--and

/only/ UNIFICATION-FAILUREs--skip to the next clause.

Fri Jan 15 07:48:53 UTC 2010 pix@kepibu.org

* Use &body instead of &rest for (arguably) prettier auto-indentation

Tue Jan 12 09:20:28 UTC 2010 pix@kepibu.org

* Fix (matching (otherwise ...))

(matching (otherwise ...)) expands into (cond (otherwise ...)), which

generates an unbound-variable error when executed, because COND does

not special-case OTHERWISE as CASE does.

--- old-cl-unification-1/ACKNOWLEDGEMENTS 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/ACKNOWLEDGEMENTS 2013-07-24 02:55:29.000000000 +0000

@@ -7,6 +7,7 @@

fixes.

Boldyrev, Ivan

+Brown, Robert

Korablin, Vladimir V.

Leuner, John

McManus, Russell

--- old-cl-unification-1/COPYING 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/COPYING 2013-07-24 02:55:29.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

--- old-cl-unification-1/ChangeLog 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/ChangeLog 2013-07-24 02:55:29.000000000 +0000

@@ -1,3 +1,103 @@

+2011-03-28 Robert Brown <robert.brown at gmail.com>

+

+ * 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 <author at paniscia.local>

+

+ * .cvsignore: Updated.

+

+ * docs/html/images/Thumbs.db, docs/html/images/Thumbs.db:encryptable:

+ Removed Files:

+ Thumbs.db Thumbs.db:encryptable

+

+2011-02-26 author <author at paniscia.local>

+

+ * .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 <author at paniscia.local>

+

+ * 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 ~@<newline> 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 <robert.brown at gmail.com>

+

+ * lambda-list-parsing.lisp: Delete trailing whitespace that turned

+ ~@<newline> into a bogus format directive by converting it into

+ ~@<space><newline>

+

+ * 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 <robert.brown at gmail.com>

+

+ * unifier.lisp: Allow vectors to unify with sequence templates.

+ * test/unification-tests.lisp: new test to verify the change

+

+2011-02-16 Robert Brown <robert.brown at gmail.com>

+

+ * cl-unification.asd: Add support for asdf:test-system.

+

+ * cl-unification-test.asd: File added.

+

+2011-01-18 author <author at 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 at 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@paniscia.local>

* lib-dependent/cl-ppcre-template.asd: Initial checkin.

--- old-cl-unification-1/README 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/README 2013-07-24 02:55:29.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.

--- old-cl-unification-1/TIMESTAMP 1970-01-01 00:00:00.000000000 +0000

+++ new-cl-unification-1/TIMESTAMP 2013-07-24 02:55:29.000000000 +0000

@@ -0,0 +1 @@

+20120116

--- old-cl-unification-1/apply-substitution.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/apply-substitution.lisp 2013-07-24 02:55:29.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 --

--- old-cl-unification-1/cl-unification-lib.asd 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/cl-unification-lib.asd 2013-07-24 02:55:29.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"

--- 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 02:55:29.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")))))

--- old-cl-unification-1/cl-unification.asd 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/cl-unification.asd 2013-07-24 02:55:29.000000000 +0000

@@ -1,40 +1,56 @@

;;;; -*- 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"))

(in-package "CL-UNIFICATION-SYSTEM")

-(defclass asdf-system-definition-file (asdf:cl-source-file) ())

-(defmethod source-file-type ((c asdf-system-definition-file) (s module)) "asd")

+(when (asdf:find-system 'asdf-system-connections nil)

+ (asdf:oos 'asdf:load-op 'asdf-system-connections))

+(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")

(:file "substitutions")

(:file "lambda-list-parsing")

(:file "templates-hierarchy")

+ (:file "template-reader")

(:file "unifier")

(:file "match-block")

- (:file "apply-substitution")

- #+asdf-with-optional-dependencies

+ (:file "apply-substitution")))

+

+#+asdf-system-connections

+(asdf:defsystem-connection cl-unification+cl-ppcre

+ :requires (:cl-ppcre :cl-unification)

+ :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 ((:load-only-file "unification-package")

(: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")

- ))

+ :components ((:file "named-readtable")))))

;;;; end of file -- cl-unification.asd --

--- old-cl-unification-1/cl-unification.system 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/cl-unification.system 2013-07-24 02:55:29.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 --

--- old-cl-unification-1/docs/html/control-flow.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/control-flow.html 2013-07-24 02:55:29.000000000 +0000

@@ -208,7 +208,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -218,7 +218,8 @@

Document created

</li>

</ul>

-

+-->

+

</div>

</div>

@@ -233,7 +234,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/dictionary.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/dictionary.html 2013-07-24 02:55:29.000000000 +0000

@@ -279,7 +279,7 @@

<!--

-;;; Copyright (c) 2004 Marco Antoniotti, All rigths reserved.

+;;; Copyright (c) 2004-2011 Marco Antoniotti, All rigths reserved.

;;;

;;; Permission to use, modify, and redistribute this code is hereby

;;; granted.

@@ -314,7 +314,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -324,7 +324,7 @@

Started the site.

</li>

</ul>

-

+-->

</div>

</div>

@@ -339,7 +339,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/downloads.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/downloads.html 2013-07-24 02:55:29.000000000 +0000

@@ -97,7 +97,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -109,7 +109,7 @@

Started the site.

</li>

</ul>

-

+-->

</div>

</div>

@@ -124,7 +124,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/index.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/index.html 2013-07-24 02:55:29.000000000 +0000

@@ -308,7 +308,7 @@

<!--

-;;; Copyright (c) 2004 Marco Antoniotti, All rigths reserved.

+;;; Copyright (c) 2004-2011 Marco Antoniotti, All rigths reserved.

;;;

;;; Permission to use, modify, and redistribute this code is hereby

;;; granted.

@@ -349,6 +349,8 @@

</p>

<ul>

+ <li><strong>2011-02-20</strong><br>

+ CL-UNIFICATION is now in <a href="www.quicklisp.org">Quicklisp</a>.

<li><strong>2007-11-09</strong><br>

Updated.

<li><strong>2004-11-04</strong><br>

@@ -372,7 +374,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2004-2007, Marco Antoniotti, all rights reserved.

+ &copy; 2004-2012, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/links.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/links.html 2013-07-24 02:55:29.000000000 +0000

@@ -76,7 +76,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+ <!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -94,7 +94,8 @@

Started the site.

</li>

</ul>

-

+-->

+

</div>

</div>

@@ -109,7 +110,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/mailing-lists.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/mailing-lists.html 2013-07-24 02:55:29.000000000 +0000

@@ -55,7 +55,7 @@

<!--

-;;; Copyright (c) 2004-2005 Marco Antoniotti, All rigths reserved.

+;;; Copyright (c) 2004-2011 Marco Antoniotti, All rigths reserved.

;;;

;;; Permission to use, modify, and redistribute this code is hereby

;;; granted.

@@ -90,7 +90,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -102,7 +102,7 @@

Started the site.

</li>

</ul>

-

+-->

</div>

</div>

@@ -117,7 +117,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/string-template-class.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/string-template-class.html 2013-07-24 02:55:29.000000000 +0000

@@ -122,7 +122,7 @@

<h2>Affected By:</h2>

- <p>The value of the variable *UNIFY-STRING-CASE-INSENSITIVE-P*.</p>

+ <p>The value of the variable *UNIFY-STRING-CASE-SENSITIVE-P*.</p>

<h2>Exceptional Situations:</h2>

--- old-cl-unification-1/docs/html/templates.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/templates.html 2013-07-24 02:55:29.000000000 +0000

@@ -173,7 +173,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -183,7 +183,7 @@

Document created

</li>

</ul>

-

+-->

</div>

</div>

@@ -198,7 +198,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/unification-dictionary.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/unification-dictionary.html 2013-07-24 02:55:29.000000000 +0000

@@ -38,7 +38,7 @@

<ul>

<li><a href="unify-package.html"><i>Package</i> <b>CL.EXT.DACF.UNIFICATION</b></a>

<li><a href="unify-function.html"><i>Generic function</i> <b>UNIFY</b></a>

- <li><a href="usci-variable.html"><i>Variable</i> <b>*UNIFY-STRING-CASE-INSENSITIVE*</b></a>

+ <li><a href="usci-variable.html"><i>Variable</i> <b>*UNIFY-STRING-CASE-SENSITIVE*</b></a>

<li><a href="template-class.html"><i>Class</i> <b>TEMPLATE</b></a>

<li><a href="expression-template-class.html"><i>Class</i> <b>EXPRESSION-TEMPLATE</b></a>

@@ -106,7 +106,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -118,7 +118,7 @@

Started the page.

</li>

</ul>

-

+-->

</div>

</div>

@@ -133,7 +133,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/unify-function.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/unify-function.html 2013-07-24 02:55:29.000000000 +0000

@@ -163,7 +163,7 @@

</p>

<p>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 <i>s1</i> and <i>s2</i> are

compared using STRING=, otherwise they are compared using STRING-EQUAL.

</p>

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

<h2>See Also:</h2>

<p>MAKE-EMPTY-ENVIRONMENT, UNIFICATION-FAILURE,

- *UNIFY-STRING-CASE-INSENSITIVE-P*, OCCURS-IN-P,

+ *UNIFY-STRING-CASE-SENSITIVE-P*, OCCURS-IN-P,

*OCCURENCE-CHECK-P*.</p>

<h2>Notes:</h2>

--- old-cl-unification-1/docs/html/unifying-substitutions.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/unifying-substitutions.html 2013-07-24 02:55:29.000000000 +0000

@@ -162,7 +162,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1>News</h1>

+<!-- <h1>News</h1>

<p>News in chronological order, most recent on top.

</p>

@@ -172,7 +172,7 @@

Document created

</li>

</ul>

-

+-->

</div>

</div>

@@ -187,7 +187,7 @@

<tr>

<td colspan="3" valign="bottom" align="right">

<div class="copyright">

- &copy; 2003-2004, Marco Antoniotti, all rights reserved.

+ &copy; 2003-2011, Marco Antoniotti, all rights reserved.

</div>

</td>

</tr>

--- old-cl-unification-1/docs/html/usci-variable.html 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/docs/html/usci-variable.html 2013-07-24 02:55:29.000000000 +0000

@@ -1,6 +1,6 @@

<html>

<head>

- <title>CL Unification: Variable *UNIFY-STRING-CASE-INSENSITIVE-P*</title>

+ <title>CL Unification: Variable *UNIFY-STRING-CASE-SENSITIVE-P*</title>

<link rel="stylesheet" href="main.css">

</head>

@@ -11,7 +11,7 @@

<td colspan="3">

<div class="header"

style="font-family:=Verdana,Arial,Helvetica; font-size: 18px; color: #41286f;">

- <strong><i>CL Unification: Variable *UNIFY-STRING-CASE-INSENSITIVE-P*</title></i></strong>

+ <strong><i>CL Unification: Variable *UNIFY-STRING-CASE-SENSITIVE-P*</title></i></strong>

<div class="navigation">

<a href="index.html" class="navigation-link">Home</a>

| <a href="unification-package.html" class="navigation-link">Previous</a>

@@ -33,7 +33,7 @@

<div class="content">

<div class="text" style="padding-top: 10px;">

- <h1><i>Variable</i> <strong>*UNIFY-STRING-CASE-INSENSITIVE-P*</strong></h1>

+ <h1><i>Variable</i> <strong>*UNIFY-STRING-CASE-SENSITIVE-P*</strong></h1>

<h2>Package:</h2>

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

<h2>Description:</h2>

- <p>The value of *UNIFY-STRING-CASE-INSENSITIVE-P* controls the

+ <p>The value of *UNIFY-STRING-CASE-SENSITIVE-P* controls the

behavior of the UNIFY method with signature <code>(<i>string</i> <i>string</i>)</code>.

- 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.</p>

<h2>Affected By:</h2>

--- old-cl-unification-1/lambda-list-parsing.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/lambda-list-parsing.lisp 2013-07-24 02:55:29.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

--- old-cl-unification-1/lib-dependent/cl-ppcre-template.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/lib-dependent/cl-ppcre-template.lisp 2013-07-24 02:55:29.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 --

--- old-cl-unification-1/lib-dependent/named-readtable.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-cl-unification-1/lib-dependent/named-readtable.lisp 2013-07-24 02:55:29.000000000 +0000

@@ -0,0 +1,6 @@

+;;;; Set up a named-readtable

+(in-package "CL.EXT.DACF.UNIFICATION")

+

+(named-readtables:defreadtable template-readtable

+ (:dispatch-macro-char #\# #\t #'|sharp-T-reader|)

+ (:merge :common-lisp))

--- old-cl-unification-1/match-block.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/match-block.lisp 2013-07-24 02:55:29.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,75 +12,164 @@

(intern (subseq (symbol-name v) 1)

(symbol-package v)))

-(defun %template-for-match (template)

- (if (variablep template)

- `',template ; Logical variables are special-cased.

- template))

-

-(defun %wrap-var-bindings (template environment-var forms)

- (let* ((template-vars (collect-template-vars template))

- (bindings (loop for v in template-vars

- nconc (list `(,v (find-variable-value ',v

- ,environment-var))

- `(,(clean-unify-var-name v) ,v)))))

- `(let* ,bindings

- (declare (ignorable ,@(mapcar #'first bindings)))

- ,@forms)))

+(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.

+

+template-munger should be either 'match or 'matchf, and will massage the

+template into the proper form for that macro set.

+

+clause-munger should be either 'cond, 'case, or 'nil. This affects the expected

+syntax of items in clauses as follows:

+ 'cond: { ((<template> <object>) &body) }+ default-clause

+ 'case: { (<template> &body) }+ default-clause

+ 'nil: { (<template> <object> &body) }+ default-clause

+ default-clause: [ (t &body) ]

+

+clauses is a list of forms conforming to the syntax just described.

+

+default is a single form to be executed if no other forms match.

+named is the name for a surrounding block.

+

+environment is a base environment object which template matches should extend.

+The new environments created will share frames with this environment, though any

+additional bindings will be in a new, unshared frame. environment defaults to

+'(make-empty-environment).

+

+errorp is a single form which will be evaluated to determine if error-form is

+executed.

+

+error-form is a form which is expected to generate an error (e.g., `(error

+'unification-non-exhaustive)). It defaults to providing the error returned by

+the last form which failed unification.

+

+keyform should be used only for a clause-munger of 'case. It provides the form

+to evaluate to produce the object for unification in -case macros.

+

+*Interaction between default-clause, :errorp + :error-form, and :default

+

+This function produces a giant COND form which ends one or more of these

+assorted \"default\" clauses. They are produced in a very specific order:

+1. errorp + error-form are tried first. Thus, if errorp is 't, neither the

+ default-clause in clauses will be reached, nor the :default clause. This is

+ essentially a hook to produce a pre-user default clause. (e.g., for

+ MATCH's :errorp)

+2. The default-clause in clauses, if it exists, will be tried next. Because

+ clauses is expected to contain user-specified clauses, this is expected to be

+ the user-specified default clause.

+3. Finally, the :default clause, if specified, will be tried. This is

+ essentially a hook to produce a post-user default clause. (e.g., for

+ -ECASE's error form)

+"

+ (flet ((default-clause-p (clause) (member (first clause) '(t otherwise))))

+ (let ((match-environment (gensym "MATCH-ENV-"))

+ (base-environment (gensym "BASE-ENV-"))

+ (match-error (gensym "MATCH-ERR-"))

+ (case-keyform (gensym "KEYFORM-"))

+ (match-clauses (remove-if #'default-clause-p clauses))

+ (default-clauses (remove-if-not #'default-clause-p clauses)))

+ (when (or (and (< 1 (length default-clauses))

+ ;; whether the default clause is the last one

+ (every #'eq clauses (append match-clauses default-clauses)))

+ ;; :keyform only applies for 'case

+ (and keyform (not (eq clause-munger 'case))))

+ (error 'program-error))

+ (labels ((ensure-template (template)

+ (cond (;; Logical variables are special-cased.

+ (variablep template) `',template)

+ ;; Same for lists (under matchf)

+ ((and (eq 'matchf template-munger)

+ (listp template))

+ (make-instance 'list-template

+ :spec (cons 'list template)))

+ (t template)))

+ (expand-clause (clause)

+ (destructuring-bind (template object &rest body)

+ (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)))

+ (with-unification-variables ,variables ,match-environment

+ ,@body)))))

+ (munge-clause (clause)

+ (ecase clause-munger

+ (cond (destructuring-bind (head . tail) clause

+ (if (consp head)

+ (list* (car head) (cadr head) tail)

+ clause)))

+ (case (list* (car clause) case-keyform (cdr clause)))

+ ((nil) clause))))

+ `(block ,named

+ (let ((,match-environment nil)

+ (,match-error nil)

+ (,case-keyform ,keyform)

+ (,base-environment ,(if environment

+ `(make-shared-environment ,environment)

+ '(make-empty-environment))))

+ (declare (dynamic-extent ,match-environment ,base-environment)

+ (ignorable ,case-keyform))

+ (cond

+ ,@(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))))))))))

+

+(defmacro %set-documentation ((&rest symbols) docstring)

+ `(eval-when (:load-toplevel :execute)

+ (mapcar (lambda (fn) (setf (documentation fn 'function) ,docstring))

+ ',symbols)))

(defmacro match ((template object

&key

- (match-named nil)

- (substitution '(make-empty-environment))

+ (named nil)

+ (match-named nil match-named-p)

+ (substitution nil)

(errorp t)

(error-value nil))

&body forms)

- "Sets up a lexical environment to evaluate FORMS after an unification.

-

-MATCH unifies a TEMPLATE and an OBJECT and then sets up a lexical

-environment where the variables present in the template are bound

-lexically. Note that both variable names '?FOO' and 'FOO' are bound

-for convenience.

-

-The MATCH form returns the values returned by the evaluation of the

-last of the FORMS.

-

-If ERRORP is non-NIL (the default) then the form raises a

-UNIFICATION-FAILURE, otherwise the result of evaluating ERROR-VALUE,

-whose default is NIL is returned. (Note that UNIFICATION-FAILUREs

-raising from the evaluation of FORMS will also be caught and handled

-according to ERRORP settings.)

-

-If MATCH-NAMED is not NIL, then a surrounding BLOCK named MATCH-NAMED

-is set up around the matching code.

-"

- (let ((env-var (gensym "UNIFICATION-ENV-"))

- (template (%template-for-match template))

- )

- `(block ,match-named

- (handler-case

- (let* ((,env-var (unify ,template ,object ,substitution))

- )

- ,(%wrap-var-bindings template env-var forms))

-

- ;; Yes. The above is sligthly wasteful.

-

- (unification-failure (uf)

- (if ,errorp

- (error uf)

- ,error-value))

- ))))

-

+ (when match-named-p

+ (warn ":match-named is deprecated. Use :named instead."))

+ (%match-expander 'match

+ 'nil

+ `((,template ,object ,@forms))

+ :default error-value

+ :named (or named match-named)

+ :environment substitution

+ :errorp errorp))

(defmacro matchf ((template object

&key

- (match-named nil)

- (substitution '(make-empty-environment))

+ (named nil)

+ (match-named nil match-named-p)

+ (substitution nil)

(errorp t)

(error-value nil))

&body forms)

- "Sets up a lexical environment to evaluate FORMS after an unification.

+ (when match-named-p

+ (warn ":match-named is deprecated. Use :named instead."))

+ (%match-expander 'matchf

+ 'nil

+ `((,template ,object ,@forms))

+ :default error-value

+ :named (or named match-named)

+ :environment substitution

+ :errorp errorp))

+

+(%set-documentation

+ (match matchf)

+ "Sets up a lexical environment to evaluate FORMS after an unification.

-MATCHF unifies a TEMPLATE and an OBJECT and then sets up a lexical

+MATCH and MATCHF unify a TEMPLATE and an OBJECT and then set up a lexical

environment where the variables present in the template are bound

lexically. Note that both variable names '?FOO' and 'FOO' are bound

for convenience.

@@ -86,59 +177,50 @@

MATCHF does not 'evaluate' TEMPLATE (note that using the #T syntax will

generate a template at read-time).

-The MATCHF form returns the values returned by the evaluation of the

+MATCH and MATCHF forms return the values returned by the evaluation of the

last of the FORMS.

If ERRORP is non-NIL (the default) then the form raises a

UNIFICATION-FAILURE, otherwise the result of evaluating ERROR-VALUE,

whose default is NIL is returned. (Note that UNIFICATION-FAILUREs

-raising from the evaluation of FORMS will also be caught and handled

+raising from the evaluation of FORMS will /not/ be caught and handled

according to ERRORP settings.)

-If MATCH-NAMED is not NIL, then a surrounding BLOCK named MATCH-NAMED

-is set up around the matching code.

-"

- (let ((env-var (gensym "UNIFICATION-ENV-"))

- (template (cond ((variablep template)

- `',template) ; Logical variables are special-cased.

- ((listp template) ; Same for lists.

- (make-instance 'list-template

- :spec (cons 'list template)))

- ;`',template)

- (t

- template)))

- )

- ;; Logical variables and lists are special cased for convenience.

- ;; Lists are especially inteded as abbreviation for destructuring.

- `(block ,match-named

- (handler-case

- (let* ((,env-var (unify ,template ,object ,substitution))

- )

- ,(%wrap-var-bindings template env-var forms))

-

- ;; Yes. The above is sligthly wasteful.

-

- (unification-failure (uf)

- (if ,errorp

- (error uf)

- ,error-value))

- ))))

+A surrounding BLOCK named NAMED is set up around the matching code.")

(define-condition unification-non-exhaustive (unification-failure)

- ())

+ ()

+ (:default-initargs

+ :format-control "Non exhaustive matching."))

-(defmacro matching ((&key errorp

- (default-substitution

- (make-empty-environment))

- (matching-named nil))

- &rest match-clauses)

- "MATCHING sets up a COND-like environment for multiple template matching clauses.

+(defmacro match-cond (&body clauses)

+ (%match-expander 'match 'cond clauses))

-The syntax of MATCHING comprises a number of clauses of the form

+(defmacro matchf-cond (&body clauses)

+ (%match-expander 'matchf 'cond clauses))

+(defmacro matching ((&key errorp

+ default-substitution

+ (named nil)

+ (matching-named nil matching-named-p))

+ &body match-clauses)

+ (when matching-named-p

+ (warn ":matching-named is deprecated. Use :named instead."))

+ (%match-expander 'match 'cond match-clauses

+ :errorp errorp

+ :error-form `(error 'unification-non-exhaustive)

+ :named (or named matching-named)

+ :environment default-substitution))

+

+(%set-documentation

+ (match-cond matchf-cond matching)

+ "MATCH-COND, MATCHF-COND, and MATCHING set up a COND-like environment for

+multiple template matching clauses.

+

+Their syntax comprises a number of clauses of the form

<clause> ::= <regular-clause> | <default-clause>

<regular-clause> ::= ((<template> <form>) &body <forms>)

<default-clause> ::= (t &body <forms>)

@@ -146,148 +228,69 @@

<form> and <forms> are regular Common Lisp forms.

<template> is a unification template.

-The full syntax of MATCHING is

-

- matching (&key errorp default-substitution) <clauses>

+The full syntax is

+ match-cond <clauses>

+ matchf-cond <clauses>

+ matching (&key errorp default-substitution named) <clauses>

Each clause evaluates its forms in an environment where the variables

present in the template are bound lexically. Note that both variable

names '?FOO' and 'FOO' are bound for convenience.

-The values returned by the MATCHING form are those of the last form in

+The values returned by the macros are those of the last form in

the first clause that satisfies the match test.

If ERRORP is non-NIL then if none of the regular clauses matches, then

an error of type UNIFICATION-NON-EXAUSTIVE is signalled, regardless of

any default clause. Otherwise, the default clause behaves as a

standard COND default clause. The default value of ERRORP is NIL.

-"

- (declare (ignore default-substitution)) ; For the time being.

- (labels ((%%match%% (clause-var template object forms substitution)

- (let ((template (%template-for-match template))

- )

- `((setf ,clause-var

- (unify* ,template ,object ,substitution))

- ,(%wrap-var-bindings template clause-var forms))

- ))

-

- (build-match-clause (match-clause match-env-var)

- (destructuring-bind ((template object) &body forms)

- match-clause

- (%%match%% match-env-var

- template

- object

- forms

- '(make-empty-environment))))

- )

- (when (or (and (find t match-clauses :key #'first)

- (find 'otherwise match-clauses :key #'first))

- (> (count t match-clauses :key #'first) 1)

- (> (count 'otherwise match-clauses :key #'first) 1))

- (error 'program-error))

- (let* ((default-clause (or (find t match-clauses

- :key #'first)

- (find 'otherwise match-clauses

- :key #'first)))

- (match-clauses (delete default-clause match-clauses)) ; EQL

- ; test

- ; suffices.

- (match-clauses-env-vars (mapcar (lambda (mc)

- (declare (ignore mc))

- (gensym "UNIFICATION-ENV-")

- )

- match-clauses))

- )

-

- `(block ,matching-named

- (let ,match-clauses-env-vars

- (declare (dynamic-extent ,@match-clauses-env-vars))

- (cond ,@(mapcar (lambda (match-clause match-clause-env-var)

- (build-match-clause match-clause

- match-clause-env-var))

- match-clauses

- match-clauses-env-vars)

- (,errorp

- (error 'unification-non-exhaustive

- :format-control "Non exhaustive matching."))

- ,@(when default-clause (list default-clause))))))

- ))

-

-

-;;; match-case --

-;;; Implementation provided by Peter Scott.

-;;;

-;;; Notes:

-;;;

-;;; [MA 20071109]

-;;; The construction of the inner MATCH clauses could be done

-;;; more intelligently by supplying :ERRORP NIL, thus avoiding the

-;;; HANDLER-CASEs, which are quite expensive. Any takers?

-

-(defmacro match-case ((object &key errorp default-substitution match-case-named)

- &rest clauses)

- "MATCH-CASE sets up a CASE-like environment for multiple template matching clauses.

+")

-The syntax of MATCH-CASE comprises a number of clauses of the form

- <clause> ::= <regular-clause> | <default-clause>

- <regular-clause> ::= (<template> &body <forms>)

- <default-clause> ::= (t &body <forms>)

- | (otherwise &body <forms>)

-<form> and <forms> are regular Common Lisp forms.

-<template> is a unification template.

-

-The full syntax of MATCH-CASE is

-

- match-case <object> (&key errorp default-substitution) <clauses>

-

-Each clause evaluates its forms in an environment where the variables

-present in the template are bound lexically. Note that both variable

-names '?FOO' and 'FOO' are bound for convenience.

-

-The values returned by the MATCH-CASE form are those of the last form in

-the first clause that satisfies the match test.

-

-If ERRORP is non-NIL then if none of the regular clauses matches, then

-an error of type UNIFICATION-NON-EXAUSTIVE is signalled, regardless of

-any default clause. Otherwise, the default clause behaves as a

-standard CASE default clause. The default value of ERRORP is NIL.

-"

- (declare (ignore default-substitution)) ; For the time being.

- (let* ((object-var (gensym "OBJECT-VAR-"))

- (otherwise-clause-present-p

- (member (caar (last clauses)) '(t otherwise)))

- (non-otherwise-clauses

- (if otherwise-clause-present-p

- (butlast clauses)

- clauses))

- (otherwise-clause

- (if otherwise-clause-present-p

- (first (last clauses))

- (when errorp

- `(t (error 'unification-non-exhaustive

- :format-control "Non exhaustive matching.")))))

- )

- (labels ((generate-matchers (clauses)

- (if (null clauses)

- `(progn ,@(rest otherwise-clause))

- (destructuring-bind (pattern &rest body)

- (car clauses)

- `(handler-case (match (,pattern ,object-var)

- ,@body)

- (unification-failure ()

- ,(generate-matchers (cdr clauses))))))))

- `(block ,match-case-named

- (let ((,object-var ,object))

- ,(generate-matchers non-otherwise-clauses))))))

-

-

-(defmacro matchf-case ((object &key errorp default-substitution match-case-named)

- &rest clauses)

- "MATCHF-CASE sets up a CASE-like environment for multiple template matching clauses.

-

-The syntax of MATCHF-CASE comprises a number of clauses of the form

+(defmacro match-case ((object &key errorp default-substitution named (match-case-named nil match-case-named-p))

+ &body clauses)

+ (when match-case-named-p

+ (warn ":match-case-named is deprecated. Use :named instead."))

+ (%match-expander 'match 'case clauses

+ :named (or named match-case-named)

+ :environment default-substitution

+ :errorp errorp

+ :error-form `(error 'unification-non-exhaustive)

+ :keyform object))

+

+(defmacro match-ecase ((object &key default-substitution named)

+ &body clauses)

+ (%match-expander 'match 'case clauses

+ :named named

+ :environment default-substitution

+ :default `(error 'unification-non-exhaustive)

+ :keyform object))

+

+(defmacro matchf-case ((object &key errorp default-substitution named (match-case-named nil match-case-named-p))

+ &body clauses)

+ (when match-case-named-p

+ (warn ":match-case-named is deprecated. Use :named instead."))

+ (%match-expander 'matchf 'case clauses

+ :named (or named match-case-named)

+ :environment default-substitution

+ :errorp errorp

+ :error-form `(error 'unification-non-exhaustive)

+ :keyform object))

+

+(defmacro matchf-ecase ((object &key default-substitution named)

+ &body clauses)

+ (%match-expander 'matchf 'case clauses

+ :named named

+ :environment default-substitution

+ :default `(error 'unification-non-exhaustive)

+ :keyform object))

+

+(%set-documentation

+ (match-case match-ecase matchf-case matchf-ecase)

+ "MATCH-CASE, MATCH-ECASE, MATCHF-CASE, and MATCHF-ECASE set up a CASE-like

+environment for multiple template matching clauses.

+Their syntax comprises a number of clauses of the form

<clause> ::= <regular-clause> | <default-clause>

<regular-clause> ::= (<template> &body <forms>)

<default-clause> ::= (t &body <forms>)

@@ -295,53 +298,24 @@

<form> and <forms> are regular Common Lisp forms.

<template> is a unification template.

-The full syntax of MATCHF-CASE is

-

- matchf-case <object> (&key errorp default-substitution) <clauses>

+The full syntax is

+ match-case (<object> &key default-substitution named errorp) <clauses>

+ match-ecase (<object> &key default-substitution named) <clauses>

+ matchf-case (<object> &key default-substitution named errorp) <clauses>

+ matchf-ecase (<object> &key default-substitution named) <clauses>

Each clause evaluates its forms in an environment where the variables

present in the template are bound lexically. Note that both variable

names '?FOO' and 'FOO' are bound for convenience.

-The values returned by the MATCH-CASE form are those of the last form in

+The values returned by the macros are those of the last form in

the first clause that satisfies the match test.

-If ERRORP is non-NIL then if none of the regular clauses matches, then

-an error of type UNIFICATION-NON-EXAUSTIVE is signalled, regardless of

-any default clause. Otherwise, the default clause behaves as a

-standard CASE default clause. The default value of ERRORP is NIL.

+MATCHF-ECASE and MATCHF-CASE behave like MATCH-ECASE and MATCH-CASE, but the

+patterns are not evaluated (i.e., they rely on MATCHF instead of MATCH to

+construct the macro expansion).

+")

-MATCHF-CASE behaves like MATCH-CASE, but the patterns are not

-evaluated (i.e., it relies on MATCHF instead of MATCH to construct the

-macro expansion.

-"

- (declare (ignore default-substitution)) ; For the time being.

- (let* ((object-var (gensym "OBJECT-VAR-"))

- (otherwise-clause-present-p

- (member (caar (last clauses)) '(t otherwise)))

- (non-otherwise-clauses

- (if otherwise-clause-present-p

- (butlast clauses)

- clauses))

- (otherwise-clause

- (if otherwise-clause-present-p

- (first (last clauses))

- (when errorp

- `(t (error 'unification-non-exhaustive

- :format-control "Non exhaustive matching.")))))

- )

- (labels ((generate-matchers (clauses)

- (if (null clauses)

- `(progn ,@(rest otherwise-clause))

- (destructuring-bind (pattern &rest body)

- (car clauses)

- `(handler-case (matchf (,pattern ,object-var)

- ,@body)

- (unification-failure ()

- ,(generate-matchers (cdr clauses))))))))

- `(block ,match-case-named

- (let ((,object-var ,object))

- ,(generate-matchers non-otherwise-clauses))))))

;;;;---------------------------------------------------------------------------

;;;; Testing.

--- old-cl-unification-1/substitutions.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/substitutions.lisp 2013-07-24 02:55:29.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,26 @@

(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))))

(defun empty-environment-p (env)

(declare (type environment env))

@@ -163,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))

@@ -182,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 --

--- old-cl-unification-1/template-reader.lisp 1970-01-01 00:00:00.000000000 +0000

+++ new-cl-unification-1/template-reader.lisp 2013-07-24 02:55:29.000000000 +0000

@@ -0,0 +1,67 @@

+;;; Setting up the reader macro.

+(in-package "CL.EXT.DACF.UNIFICATION")

+

+;;; 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)))

+ (typecase spec

+ (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))

+

+

+#||

+;;; 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))

+ (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 '|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)))

+

+||#

+

+(defmacro enable-template-reader ()

+ `(eval-when (:compile-toplevel :load-toplevel :execute)

+ (setf *readtable* (copy-readtable *readtable*))

+ (set-dispatch-macro-character #\# #\T '|sharp-T-reader|)))

--- old-cl-unification-1/templates-hierarchy.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/templates-hierarchy.lisp 2013-07-24 02:55:29.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)))

@@ -231,70 +233,6 @@

(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)))

- (typecase spec

- (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))

-

-

-#||

-;;; 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))

- (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 '|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)

(make-instance 'nil-template :spec spec))

--- old-cl-unification-1/test/unification-tests.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/test/unification-tests.lisp 2013-07-24 02:55:29.000000000 +0000

@@ -1,12 +1,17 @@

;;;; -*- Mode: Lisp -*-

;;;; unification-tests.lisp --

-;;;; CL-UNIFICATION test suite. Requires Franz's util.test package.

+;;;; 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"))

(in-package "UNIFY.TESTS")

-(use-package "UNIFY")

-(use-package "UTIL.TEST")

+;; nil seems like a lousy default for this

+(setf *error-protect-tests* t)

(with-tests (:name "basic constant unification")

(test t (unify:environment-p (unify 42 42)))

@@ -38,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"))))

)

@@ -97,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

@@ -106,6 +113,8 @@

)

+(eval-when (:compile-toplevel :load-toplevel :execute)

+

(defclass test1 ()

((a :initarg :a :accessor a)

(b :initarg :b :accessor b)))

@@ -113,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) (_ _ _))

@@ -187,6 +198,12 @@

)

+(define-condition inner-unification-failure (unification-failure) ()

+ (:default-initargs :format-control "Inner unification-failure."))

+(define-condition inner-error (simple-error) ()

+ (:default-initargs :format-control "Inner error."))

+(define-condition outer-error (simple-error) ()

+ (:default-initargs :format-control "Outer error."))

(defun nested-match-cases (input)

(match-case (input)

@@ -195,16 +212,85 @@

collect (match-case (b)

('(:c ?c) ?c)

('(:d ?d) ?d)

- (otherwise (error "error-inner")))))

- (otherwise (error "error-outer"))))

-

-(with-tests (:name "control flow")

- (test-error (nested-match-cases '(:a 42 :b 33)) :announce t)

+ (otherwise (error 'inner-error)))))

+ (otherwise (error 'outer-error))))

- (test-error (nested-match-cases '(:a 42 :b (33 42))) :announce t)

+(defun nested-matchf-cases (input)

+ (matchf-case (input)

+ ((:a ?a :b #T(list &rest ?bs))

+ (loop for b in ?bs

+ collect (matchf-case (b)

+ ((:c ?c) ?c)

+ ((:d ?d) ?d)

+ (otherwise (error 'inner-error)))))

+ (otherwise (error 'outer-error))))

+(with-tests (:name "control flow")

+ (test-error (nested-match-cases '(:a 42 :b 33)) :condition-type 'outer-error)

+ (test-error (nested-match-cases '(:a 42 :b (33 42))) :condition-type 'inner-error)

(test '(42 43 44) (nested-match-cases '(:a 42 :b ((:d 42) (:c 43) (:c 44))))

:test #'equal)

+

+ (test-error (nested-matchf-cases '(:a 42 :b 33)) :condition-type 'outer-error)

+ (test-error (nested-matchf-cases '(:a 42 :b (33 42))) :condition-type 'inner-error)

+ (test '(42 43 44) (nested-matchf-cases '(:a 42 :b ((:d 42) (:c 43) (:c 44))))

+ :test #'equal)

+

+ (test-error (match ('(x) '(x) :errorp nil)

+ (error 'inner-unification-failure))

+ :condition-type 'inner-unification-failure)

+

+ (test-error (matchf ((x) '(x) :errorp nil)

+ (error 'inner-unification-failure))

+ :condition-type 'inner-unification-failure)

+

+ (with-tests (:name "final t-or-otherwise")

+ (test :success (matching ()

+ (('x 'y) :fail)

+ (t :success)))

+ (test :success (matching ()

+ (('x 'y) :fail)

+ (otherwise :success)))

+ (test :success (match-case ('x)

+ ('y :fail)

+ (t :success)))

+ (test :success (match-case ('x)

+ ('y :fail)

+ (otherwise :success)))

+ (test :success (matchf-case ('(x))

+ ((y) :fail)

+ (t :success)))

+ (test :success (matchf-case ('(x))

+ ((y) :fail)

+ (otherwise :success))))

+

+ (test-error (matching ()

+ (('x 'y) :fail)

+ (('x 'x) (error 'inner-unification-failure))

+ (('?x 'x) x))

+ :condition-type 'inner-unification-failure)

+

+ (test-error (match-case ('(x))

+ ('(y) :fail)

+ ('(x) (error 'inner-unification-failure))

+ ('(?x) x))

+ :condition-type 'inner-unification-failure)

+

+ (test-error (matchf-case ('(x))

+ ((y) :fail)

+ ((x) (error 'inner-unification-failure))

+ ((?x) x))

+ :condition-type 'inner-unification-failure)

+

+ (test 'sym (match-case ('(sym))

+ ('(a) :fail)

+ ('(b) :fail)

+ ('(?x) x)))

+

+ (test 'sym (matchf-case ('(sym))

+ ((a) :fail)

+ ((b) :fail)

+ ((?x) x)))

)

--- old-cl-unification-1/unification-package.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/unification-package.lisp 2013-07-24 02:55:29.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,17 +16,9 @@

The package also has the \"UNIFY\" nickname.")

(:export

- "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"

@@ -35,14 +27,40 @@

(: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"

"MATCHF"

+ "MATCH-COND"

+ "MATCHF-COND"

"MATCHING"

"MATCH-CASE"

+ "MATCH-ECASE"

"MATCHF-CASE"

+ "MATCHF-ECASE"

)

(:export

@@ -50,10 +68,23 @@

"UNIFY-EQUATIONS"

"UNIFY-EQUATIONS*")

+ (:export

+ "ENABLE-TEMPLATE-READER"

+ "MAKE-TEMPLATE"

+ "TEMPLATEP"

+ "TEMPLATE-SPEC"

+

+ "COLLECT-TEMPLATE-VARS"

+ )

+

#+cl-ppcre

(:export

"REGULAR-EXPRESSION"

"REGEXP")

+

+ #+named-readtables

+ (:export

+ "TEMPLATE-READTABLE")

)

;;;; end of file -- unification-package.lisp --

--- old-cl-unification-1/unifier.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/unifier.lisp 2013-07-24 02:55:29.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,16 +93,16 @@

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))

env)

- ((char-equal a b)

+ ((and (not case-sensitive) (char-equal a b))

env)

(t

(error 'unification-failure

- :format-control "Connot unify two different characters: ~S ~S."

+ :format-control "Cannot unify two different characters: ~S ~S."

:format-arguments (list a b)))))

@@ -113,16 +115,16 @@

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))

env)

- ((string-equal a b)

+ ((and (not case-sensitive) (string-equal a b))

env)

(t

(error 'unification-failure

- :format-control "Connot unify two different strings: ~S ~S."

+ :format-control "Cannot unify two different strings: ~S ~S."

:format-arguments (list 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))

)

@@ -857,7 +859,9 @@

;;; Utilities.

(defun unify* (a b &optional (env (make-empty-environment)))

- (ignore-errors (unify a b env)))

+ (handler-case

+ (unify a b env)

+ (unification-failure (c) (values nil c))))

(defun unify-equations (eqns &optional (env (make-empty-environment)))

@@ -934,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)

--- old-cl-unification-1/variables.lisp 2013-07-24 02:55:29.000000000 +0000

+++ new-cl-unification-1/variables.lisp 2013-07-24 02:55:29.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)