- cl-unification-cvs@lists.common-lisp.net

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18677 Modified Files: templates-hierarchy.lisp Log Message: Fixed a couple of problems with some accessors in the NUMBER, STRUCTURE-OBJECT and STANDARD-OBJECT templates. --- /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2009/04/15 10:18:59 1.5 +++ /project/cl-unification/cvsroot/cl-unification/templates-hierarchy.lisp 2009/12/17 16:43:12 1.6 @@ -407,6 +407,23 @@ (cons (second spec))))) +(defun number-template-numeric-type (x) + (declare (type number-template x)) + (let ((n (number-template-number x))) + (if (numberp n) + (type-of n) + (first (template-spec x))))) + +(defun number-template-numeric-class (x) + (declare (type number-template x)) + (let ((n (number-template-number x))) + (if (numberp n) + (class-of n) + (find-class (first (template-spec x)))))) + + + + ;;; Sequence Templates. ;;; Specification is ;;; @@ -493,11 +510,19 @@ ;;; Structure and Standard Object Templates. +(defun structure-object-template-class (x) + (and (structure-object-template-p x) + (first (template-spec x)))) + (defun structure-object-template-slots (x) (and (structure-object-template-p x) (rest (template-spec x)))) +(defun standard-object-template-class (x) + (and (standard-object-template-p x) + (first (template-spec x)))) + (defun standard-object-template-slots (x) (and (standard-object-template-p x) (rest (template-spec x))))

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Dec '09

17 Dec '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv18479 Modified Files: match-block.lisp Log Message: Added MATCHF* macros. --- /project/cl-unification/cvsroot/cl-unification/match-block.lisp 2009/04/15 10:16:24 1.9 +++ /project/cl-unification/cvsroot/cl-unification/match-block.lisp 2009/12/17 16:41:38 1.10 @@ -303,6 +303,68 @@ (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 + + <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 MATCHF-CASE is + + matchf-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. + +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.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv28962 Modified Files: ChangeLog Log Message: ChangeLog updated. --- /project/cl-unification/cvsroot/cl-unification/ChangeLog 2009/04/15 14:33:35 1.6 +++ /project/cl-unification/cvsroot/cl-unification/ChangeLog 2009/04/17 22:44:17 1.7 @@ -1,3 +1,71 @@ +2009-04-18 author <author(a)Macintosh-9.local> + + * cl-unification.system, cl-unification.asd: + System definitions files (.asd and .system) modified in order to make + dependency form CL-PPCRE optional. + + * lib-dependent/cl-ppcre-template.system: File added. + + * lib-dependent/cl-ppcre-template.lisp: + Removed REQUIRE of CL-PPCRE. Too brittle. + + * cl-unification-lib.asd: File added. + +2009-04-17 author <author(a)Macintosh-9.local> + + * unification-package.lisp: + Added a few exports and changed the actual package name (i.e., I put + my money where my mouth is; the "published" package name is now a + nickname). + + * apply-substitution.lisp: + Fixed a couple of snags. APPLY-SUBSTITUTION was not applied + recursively and it was barfing on numbers. + Current version is still incomplete, but it serves as a template for + further development. + +2009-04-15 author <author(a)Macintosh-9.local> + + * ChangeLog: ChangeLog updated. + + * lib-dependent/cl-ppcre-template.lisp, test/unification-tests.lisp: + Modified Files: + test/unification-tests.lisp + Added Files: + lib-dependent/cl-ppcre-template.lisp + + The cl-ppcre-template reuses E. Weitz's wonderful CL-PPCRE library + to provide a seamless (YMMV) reuse of regular expressions within + CL-UNIFICATION. + + * templates-hierarchy.lisp: Added LAMBDA-TEMPLATE. + + * substitutions.lisp: + Added some functionality to extract all variables and/or all values + from an environment or a frame. + + * match-block.lisp: + Added MATCHF (whose name may change) to simplify the + 'destructuring-bind'-like syntax and behavior of the matching + facilities. + + * COPYING: Dates updated. + + * unifier.lisp: + Major API change to 'unify'. It now accepts keywords. Old code + shouls not be affected, but new code is now more flexible. Look the + the STRING and (new) CHARACTER methods to see how this change is + affecting the code. + + * variables.lisp: Some 'diff' unfathomable change happened. + + * unification-package.lisp: Added exports of a few symbols. + + * cl-unification.system, cl-unification.asd: + Fixed a few snags and added "lib-dependent" module. + + * apply-substitution.lisp: Added some functionality and comments. + 2009-04-15 author <author(a)paniscia.pd.disco.unimib.it> * lib-dependent/cl-ppcre-template.lisp, test/unification-tests.lisp:

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv28885 Modified Files: cl-unification.system Log Message: System definitions files (.asd and .system) modified in order to make dependency form CL-PPCRE optional. --- /project/cl-unification/cvsroot/cl-unification/cl-unification.system 2009/04/15 10:09:43 1.3 +++ /project/cl-unification/cvsroot/cl-unification/cl-unification.system 2009/04/17 22:42:50 1.4 @@ -4,21 +4,21 @@ ;;;; MK:DEFSYSTEM system file. (mk:defsystem "CL-UNIFICATION" - :source-extension "lisp" - :components ("unification-package" - "variables" - "substitutions" - "lambda-list-parsing" - "templates-hierarchy" - "unifier" - "match-block" - "apply-substitution" - (:module "lib-dependent" - :depends-on ("templates-hierarchy" "unifier") - :components ( - #+cl-ppcre - (:file "cl-ppcre-template") - )) - )) + :source-extension "lisp" + :components ("unification-package" + "variables" + "substitutions" + "lambda-list-parsing" + "templates-hierarchy" + "unifier" + "match-block" + "apply-substitution" + (:module "lib-dependent" + :depends-on ("templates-hierarchy" "unifier") + :components ((:subsystem "cl-ppcre-template" + :non-required-p t + ) + )) + )) ;;; end of file -- cl-unification.system --

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv28862 Modified Files: cl-unification.asd Log Message: System definitions files (.asd and .system) modified in order to make dependency form CL-PPCRE optional. --- /project/cl-unification/cvsroot/cl-unification/cl-unification.asd 2009/04/15 10:06:40 1.2 +++ /project/cl-unification/cvsroot/cl-unification/cl-unification.asd 2009/04/17 22:42:46 1.3 @@ -3,22 +3,38 @@ ;;;; 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") - (:module "lib-dependent" - :depends-on ("templates-hierarchy" "unifier") - :components ( - #+cl-ppcre - (:file "cl-ppcre-template") - )))) +;;;;=========================================================================== +;;;; Simple stuff that should be built in ASDF. + +(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") + + +(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") + #+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") + )) ;;;; end of file -- cl-unification.asd --

1 0

[cl-unification-cvs] CVS cl-unification/lib-dependent
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification/lib-dependent In directory cl-net:/tmp/cvs-serv28811 Added Files: cl-ppcre-template.system Log Message: File added. --- /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.system 2009/04/17 22:41:34 NONE +++ /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.system 2009/04/17 22:41:34 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-ppcre-template.system -- ;;;; MK system file. (mk:defsystem "CL-PPCRE-TEMPLATE" :author "Marco Antoniotti" :non-required-p t :components ((:file "cl-ppcre-template")) :depends-on ("CL-PPCRE")) ;;;; end of file -- cl-ppcre-template.system --

1 0

[cl-unification-cvs] CVS cl-unification/lib-dependent
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification/lib-dependent In directory cl-net:/tmp/cvs-serv28352 Modified Files: cl-ppcre-template.lisp Log Message: Removed REQUIRE of CL-PPCRE. Too brittle. --- /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/04/15 10:24:28 1.1 +++ /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/04/17 22:40:29 1.2 @@ -5,8 +5,6 @@ (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. -(require "CL-PPCRE") - ;;;; REGEXP Templates. ;;;; Another extension of the type specifier language.

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv26484 Added Files: cl-unification-lib.asd Log Message: File added. --- /project/cl-unification/cvsroot/cl-unification/cl-unification-lib.asd 2009/04/17 22:39:06 NONE +++ /project/cl-unification/cvsroot/cl-unification/cl-unification-lib.asd 2009/04/17 22:39:06 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-unification-lib.asd -- ;;;; ASDF system file. (asdf:defsystem :cl-unification-lib :author "Marco Antoniotti" :components ((:module "lib-dependent" :components ((:file "cl-ppcre-template")))) :depends-on (cl-ppcre cl-unification)) ;;;; end of file -- cl-unification-lib.asd --

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv19172 Modified Files: unification-package.lisp Log Message: Added a few exports and changed the actual package name (i.e., I put my money where my mouth is; the "published" package name is now a nickname). --- /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2009/04/15 10:10:25 1.5 +++ /project/cl-unification/cvsroot/cl-unification/unification-package.lisp 2009/04/17 07:53:58 1.6 @@ -1,7 +1,14 @@ -;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Lisp -*- -(defpackage "CL.EXT.DACF.UNIFICATION" (:use "CL") - (:nicknames "UNIFY") +;;;; unification-package.lisp -- +;;;; Package definition for the CL-UNIFICATION library. +;;;; +;;;; Copyright (c) 2004-2009 Marco Antoniotti +;;;; See file COPYING for licensing information. + + +(defpackage "IT.UNIMIB.DISCO.MA.CL.EXT.DACF.UNIFICATION" (:use "CL") + (:nicknames "CL.EXT.DACF.UNIFICATION" "UNIFY" "unify") (:documentation "The CL.EXT.DACF.UNIFICATION Package. This package contains all the definitions necessary for the general @@ -40,6 +47,11 @@ "UNIFY*" "UNIFY-EQUATIONS" "UNIFY-EQUATIONS*") + + #+cl-ppcre + (:export + "REGULAR-EXPRESSION" + "REGEXP") ) -;;; end of file -- unification-package.lisp -- +;;;; end of file -- unification-package.lisp --

1 0

[cl-unification-cvs] CVS cl-unification
by mantoniotti 17 Apr '09

17 Apr '09

Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv19119 Modified Files: apply-substitution.lisp Log Message: Fixed a couple of snags. APPLY-SUBSTITUTION was not applied recursively and it was barfing on numbers. Current version is still incomplete, but it serves as a template for further development. --- /project/cl-unification/cvsroot/cl-unification/apply-substitution.lisp 2009/04/15 10:05:58 1.3 +++ /project/cl-unification/cvsroot/cl-unification/apply-substitution.lisp 2009/04/17 07:52:25 1.4 @@ -17,6 +17,11 @@ (defgeneric apply-substitution (substitution item &optional exclude-vars)) +(defmethod apply-substitution ((s environment) (n number) &optional exclude-vars) + (declare (ignore exclude-vars)) + n) + + (defmethod apply-substitution ((substitution environment) (s symbol) &optional (exclude-vars ())) (declare (type list exclude-vars)) @@ -26,7 +31,7 @@ s (multiple-value-bind (val foundp) (find-variable-value s substitution) - (cond (foundp val) + (cond (foundp (apply-substitution substitution val exclude-vars)) (t (warn "~S is a free variable in the current environment." s) s))))

1 0