Add (enable-template-reader), so it is easy to turn on the template reader --> to head
/template-reader.lisp
Ignoring non-repository paths: /template-reader.lisp
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.
diff -rN -u old-cl-unification-1/ACKNOWLEDGEMENTS new-cl-unification-1/ACKNOWLEDGEMENTS
--- old-cl-unification-1/ACKNOWLEDGEMENTS 2013-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/ACKNOWLEDGEMENTS 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/COPYING 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/ChangeLog 2013-06-11 12:05:36.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.
diff -rN -u old-cl-unification-1/README new-cl-unification-1/README
--- old-cl-unification-1/README 2013-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/README 2013-06-11 12:05:36.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-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/apply-substitution.lisp 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/cl-unification-lib.asd 2013-06-11 12:05:36.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-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/cl-unification.asd 2013-06-11 12:05:36.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,37 +11,46 @@
(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")
(:file "substitutions")
(:file "lambda-list-parsing")
(:file "templates-hierarchy")
+ (: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 ((: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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/cl-unification.system 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/control-flow.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/dictionary.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/downloads.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/index.html 2013-06-11 12:05:36.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>
diff -rN -u old-cl-unification-1/docs/html/links.html new-cl-unification-1/docs/html/links.html
--- old-cl-unification-1/docs/html/links.html 2013-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/links.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/mailing-lists.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/string-template-class.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/templates.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/unification-dictionary.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/unify-function.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/unifying-substitutions.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/docs/html/usci-variable.html 2013-06-11 12:05:36.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>
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/lambda-list-parsing.lisp 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/lib-dependent/cl-ppcre-template.lisp 2013-06-11 12:05:36.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/lib-dependent/named-readtable.lisp new-cl-unification-1/lib-dependent/named-readtable.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-06-11 12:05:36.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))
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/match-block.lisp 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/substitutions.lisp 2013-06-11 12:05:36.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/template-reader.lisp new-cl-unification-1/template-reader.lisp
--- old-cl-unification-1/template-reader.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-cl-unification-1/template-reader.lisp 2013-06-11 12:05:36.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|)))
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/templates-hierarchy.lisp 2013-06-11 12:05:36.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))
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/test/unification-tests.lisp 2013-06-11 12:05:36.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) (_ _ _))
@@ -230,7 +236,7 @@
(test '(42 43 44) (nested-matchf-cases '(:a 42 :b ((:d 42) (:c 43) (:c 44))))
:test #'equal)
- (test-error (match ('(x) '(xx) :errorp nil)
+ (test-error (match ('(x) '(x) :errorp nil)
(error 'inner-unification-failure))
:condition-type 'inner-unification-failure)
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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/unification-package.lisp 2013-06-11 12:05:36.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,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"
@@ -54,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 --
diff -rN -u old-cl-unification-1/unifier.lisp new-cl-unification-1/unifier.lisp
--- old-cl-unification-1/unifier.lisp 2013-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/unifier.lisp 2013-06-11 12:05:36.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-06-11 12:05:36.000000000 +0000
+++ new-cl-unification-1/variables.lisp 2013-06-11 12:05:36.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)