From mantoniotti at common-lisp.net Fri Nov 9 13:30:53 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:30:53 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109133053.653542D16C@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29446 Modified Files: unification.asd Log Message: Marked the two system building files as 'obsolete', before removing them from the repository. The new files are prefixed by 'cl-'. --- /project/cl-unification/cvsroot/cl-unification/unification.asd 2007/05/21 12:33:18 1.2 +++ /project/cl-unification/cvsroot/cl-unification/unification.asd 2007/11/09 13:30:53 1.3 @@ -2,8 +2,12 @@ ;;; unification.asd -- ;;; ASDF system file. +;;; +;;; Note: +;;; [20071109 MA] +;;; This file is OBSOLETE. Use 'cl-unification.asd' instead. -(asdf:defsystem unification +(asdf:defsystem cl-unification :author "Marco Antoniotti" :serial t :components ((:file "unification-package") From mantoniotti at common-lisp.net Fri Nov 9 13:30:55 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:30:55 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109133055.8F00D2D171@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29467 Modified Files: unification.system Log Message: Marked the two system building files as 'obsolete', before removing them from the repository. The new files are prefixed by 'cl-'. --- /project/cl-unification/cvsroot/cl-unification/unification.system 2007/05/21 12:29:24 1.2 +++ /project/cl-unification/cvsroot/cl-unification/unification.system 2007/11/09 13:30:55 1.3 @@ -1,5 +1,12 @@ ;;; -*- Mode: Lisp -*- +;;; unification.system -- +;;; MK:DEFSYSTEM system file. +;;; +;;; Note: +;;; [20071109 MA] +;;; This file is OBSOLETE. Use 'cl-unification.system' instead. + (mk:defsystem "UNIFICATION" :components ("unification-package" "variables" From mantoniotti at common-lisp.net Fri Nov 9 13:34:18 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:34:18 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109133418.48F4E2D16C@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29825 Added Files: cl-unification.asd Log Message: Added the new system building files with more meaningful names w.r.t. the name of the library. --- /project/cl-unification/cvsroot/cl-unification/cl-unification.asd 2007/11/09 13:34:18 NONE +++ /project/cl-unification/cvsroot/cl-unification/cl-unification.asd 2007/11/09 13:34:18 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-unification.asd -- ;;;; ASDF system file. (asdf:defsystem cl-unification :author "Marco Antoniotti" :serial t :components ((:file "unification-package") (:file "variables") (:file "substitutions") (:file "lambda-list-parsing") (:file "templates-hierarchy") (:file "unifier") (:file "match-block") (:file "apply-substitution"))) ;;;; end of file -- cl-unification.asd -- From mantoniotti at common-lisp.net Fri Nov 9 13:34:21 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:34:21 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109133421.A8EC9340B0@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv29862 Added Files: cl-unification.system Log Message: Added the new system building files with more meaningful names w.r.t. the name of the library. --- /project/cl-unification/cvsroot/cl-unification/cl-unification.system 2007/11/09 13:34:21 NONE +++ /project/cl-unification/cvsroot/cl-unification/cl-unification.system 2007/11/09 13:34:21 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-unification.system -- ;;;; MK:DEFSYSTEM system file. (mk:defsystem "CL-UNIFICATION" :components ("unification-package" "variables" "substitutions" "lambda-list-parsing" "templates-hierarchy" "unifier" "match-block" "apply-substitution")) ;;; end of file -- cl-unification.system -- From mantoniotti at common-lisp.net Fri Nov 9 13:35:55 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:35:55 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109133555.82982340AC@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv30125 Modified Files: substitutions.lisp Log Message: Changed the top comment and added a (:copier nil) option to the ENVIRONMENT defstruct, as COPY-ENVIRONMENT is defined later in the file. --- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2007/05/21 12:33:09 1.2 +++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2007/11/09 13:35:55 1.3 @@ -1,8 +1,8 @@ -;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Lisp -*- -;;; substitutions.lisp -;;; General CL structures unifier. -;;; Substitution definitions. +;;;; substitutions.lisp -- +;;;; General CL structures unifier. +;;;; Substitution definitions. Mostly a rehash of the usual SICP stuff. (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. @@ -76,7 +76,8 @@ ;;;--------------------------------------------------------------------------- ;;; Environments. -(defstruct (environment (:print-object print-environment)) +(defstruct (environment (:print-object print-environment) + (:copier nil)) (frames () :type list)) (defun print-environment (env stream) @@ -137,4 +138,4 @@ env)) -;;; end of file -- substitutions.lisp -- +;;;; end of file -- substitutions.lisp -- From mantoniotti at common-lisp.net Fri Nov 9 13:43:20 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:43:20 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109134320.CF01D340B0@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv328 Modified Files: match-block.lisp Log Message: Made several changes to improve MATCH-CASE (following a note from Ivan Boldyrev from a long time ago), MATCHING and MATCH. Else-clauses are now handled correctly (AFAICT). Single variable templates in MATCH, MATCH-CASE and MATCHING clauses do not need to be quoted. MATCHING was generating one gensym'ed variable per clause without creating an appropriate enclosing LET. This is now fixed. --- /project/cl-unification/cvsroot/cl-unification/match-block.lisp 2007/05/21 12:33:07 1.7 +++ /project/cl-unification/cvsroot/cl-unification/match-block.lisp 2007/11/09 13:43:20 1.8 @@ -1,4 +1,7 @@ -;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Lisp -*- + +;;;; match-block.lisp -- +;;;; Various macros built on top of the unifier: MATCH, MATCHING and MATCH-CASE. (in-package "UNIFY") @@ -14,7 +17,8 @@ (errorp t) (error-value nil)) &body forms) - "Sets up a lexical environment to evaluate FORMS after a unification operation. + "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 @@ -31,10 +35,14 @@ " (let ((template-vars (collect-template-vars template)) (env-var (gensym "UNIFICATION-ENV-")) + (template (if (variablep template) + `',template ; Logical variables are special-cased. + template)) ) (flet ((generate-var-bindings () (loop for v in template-vars - nconc (list `(,v (find-variable-value ',v ,env-var)) + nconc (list `(,v (find-variable-value ',v + ,env-var)) `(,(clean-unify-var-name v) ,v)))) ) `(block nil @@ -42,7 +50,8 @@ (let* ((,env-var (unify ,template ,object ,substitution)) ,@(generate-var-bindings) ) - (declare (ignorable ,@(mapcar #'first (generate-var-bindings)))) + (declare (ignorable ,@(mapcar #'first + (generate-var-bindings)))) , at forms) ;; Yes. The above is sligthly wasteful. @@ -60,9 +69,11 @@ (defmacro matching ((&key errorp - (default-substitution (make-empty-environment))) + (default-substitution + (make-empty-environment))) &rest match-clauses) "MATCHING sets up a COND-like environment for multiple template matching clauses. + The syntax of MATCHING comprises a number of clauses of the form ::= | @@ -90,7 +101,12 @@ " (declare (ignore default-substitution)) ; For the time being. (labels ((%%match%% (clause-var template object forms substitution) - (let ((template-vars (collect-template-vars template))) + (let ((template-vars (collect-template-vars template)) + (template (if (variablep template) + `',template ; Logical variables are + ; special-cased. + template)) + ) (flet ((generate-var-bindings () (loop for v in template-vars nconc (list `(,v (find-variable-value @@ -99,7 +115,7 @@ `(,(clean-unify-var-name v) ,v)))) ) `((setf ,clause-var - (ignore-errors (unify ',template + (ignore-errors (unify ,template ,object ,substitution))) (let* (,@(generate-var-bindings)) @@ -120,32 +136,49 @@ (> (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. + (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 - (cond ,@(mapcar (lambda (match-clause match-clause-env-var) - (build-match-clause match-clause match-clause-env-var)) - match-clauses - (mapcar (lambda (mc) - (declare (ignore mc)) - (gensym "UNIFICATION-ENV-") - ) - match-clauses)) - (,errorp - (error 'unification-non-exhaustive - :format-control "Non exhaustive matching.")) - ,@(when default-clause (list default-clause))))) - )) + `(block matching + (let ,match-clauses-env-vars + (declare (dynamic-extent , at 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] +;;; When 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) &rest clauses) +(defmacro match-case ((object &key errorp default-substitution) + &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 ::= | @@ -183,8 +216,8 @@ (if otherwise-clause-present-p (first (last clauses)) (when errorp - `(error 'unification-non-exhaustive - :format-control "Non exhaustive matching.")))) + `(t (error 'unification-non-exhaustive + :format-control "Non exhaustive matching."))))) ) (labels ((generate-matchers (clauses) (if (null clauses) @@ -198,5 +231,34 @@ `(let ((,object-var ,object)) ,(generate-matchers non-otherwise-clauses))))) +;;;;--------------------------------------------------------------------------- +;;;; Testing. + +#| Tests + +(let ((n 42)) + (matching () + ((0 n) 1) + ((?x n) (* x (1- x))))) + + +(let ((n 42)) + (match-case (n) + (0 1) + (?x (* x (1- x))))) + + +(let ((n 42)) + (match-case (n) + (0 1) + (otherwise (* n (1- n))))) + +(defun fatt (x) + (match-case (x :errorp t) + (0 1) + (#T(number ?n) (* ?n (fatt (1- n)))) + )) + +|# -;;; end of file -- math-blocks.lisp -- +;;;; end of file -- math-blocks.lisp -- From mantoniotti at common-lisp.net Fri Nov 9 13:47:01 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:47:01 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification Message-ID: <20071109134701.0B72B340B5@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification In directory clnet:/tmp/cvs-serv789 Modified Files: ChangeLog Log Message: ChangeLog updated. --- /project/cl-unification/cvsroot/cl-unification/ChangeLog 2007/05/21 17:12:58 1.3 +++ /project/cl-unification/cvsroot/cl-unification/ChangeLog 2007/11/09 13:47:00 1.4 @@ -1,3 +1,55 @@ +2007-11-09 author + + * match-block.lisp: + Made several changes to improve MATCH-CASE (following a note from Ivan + Boldyrev from a long time ago), MATCHING and MATCH. + + Else-clauses are now handled correctly (AFAICT). + + Single variable templates in MATCH, MATCH-CASE and MATCHING clauses do + not need to be quoted. + + MATCHING was generating one gensym'ed variable per clause without + creating an appropriate enclosing LET. This is now fixed. + + * substitutions.lisp: + Changed the top comment and added a (:copier nil) option to the + ENVIRONMENT defstruct, as COPY-ENVIRONMENT is defined later in the + file. + + * cl-unification.system, cl-unification.asd: + Added the new system building files with more meaningful names + w.r.t. the name of the library. + + * unification.asd, unification.system: + Marked the two system building files as 'obsolete', before removing + them from the repository. The new files are prefixed by 'cl-'. + +2007-05-21 author + + * ChangeLog: ChangeLog updated. + + * README, ACKNOWLEDGEMENTS, COPYING, INSTALLATION: + Updated copyrights dates and changed a few instructions in the + INSTALLATION file. + + * docs/html/index.html: Updated copyrights dates. + + * ChangeLog: ChangeLog updated. + + * unification-package.lisp, unification.asd, apply-substitution.lisp, match-block.lisp, substitutions.lisp: + See previous message. + + * unification.system: + Added file 'apply-substitition.lisp' with a few new functions that are + a start for the variable substitition operation. + + New fixes to the MATCH and MATCH-CASE macros. They should now work as + advertised. + + Minor changes to other files: added exports to package file, fixed + .system and .asd files. + 2007-05-21 author * README, ACKNOWLEDGEMENTS, COPYING, INSTALLATION: From mantoniotti at common-lisp.net Fri Nov 9 13:56:40 2007 From: mantoniotti at common-lisp.net (mantoniotti) Date: Fri, 9 Nov 2007 08:56:40 -0500 (EST) Subject: [cl-unification-cvs] CVS cl-unification/docs/html Message-ID: <20071109135640.27EDC1130@common-lisp.net> Update of /project/cl-unification/cvsroot/cl-unification/docs/html In directory clnet:/tmp/cvs-serv1902 Modified Files: index.html Log Message: Changed the position of the disclaimer. --- /project/cl-unification/cvsroot/cl-unification/docs/html/index.html 2007/05/21 17:10:26 1.5 +++ /project/cl-unification/cvsroot/cl-unification/docs/html/index.html 2007/11/09 13:56:40 1.6 @@ -34,23 +34,6 @@

Common Lisp Extensions: UNIFICATION

- -
- -

- DISCLAIMER: The code associated to these documents is not - completely tested and it is bound to contain errors and omissions. - This documentation may contain errors and omissions as well.

- -

The file COPYING contains a Berkeley-style license. You - are advised to use the code at your own risk. No warranty - whatsoever is provided, the author will not be held responsible for - any effect generated by your use of the library, and you can put - here the scarier extra disclaimer you can think of. -

- -
-

The notion of unification originated in the field of formal logic (e.g. [R65],) and has been used extensively in Computer Science and Programming Languages. Most @@ -303,6 +286,25 @@ [R56] J. A. Robinson, A machine-oriented logic based on the resolution principle, Journal of the ACM, Vol. 12, No. 1, January 1965, Pages 23--49.

+ + +

+
+ +

+ DISCLAIMER: The code associated to these documents is not + completely tested and it is bound to contain errors and omissions. + This documentation may contain errors and omissions as well.

+ +

The file COPYING contains a Berkeley-style license. You + are advised to use the code at your own risk. No warranty + whatsoever is provided, the author will not be held responsible for + any effect generated by your use of the library, and you can put + here the scarier extra disclaimer you can think of. +

+ +
+