Hi
I fixed the bugs you reported. Thanks a lot for spotting them. I also clarified the disclaimer and noted that the COPYING file contains a Berkeley-style license.
I have not yet added your INTERFACE template. I am quibbling on the name. I would like to call it an ACCESS template, as INTERFACE is a bit overloaded. How do you feel about it?
Cheers -- Marco
On May 17, 2005, at 2:52 PM, norman werner wrote:
Oops - New email-webinterface.
I have to apologize.
Norman file in included and as attachment
;; Copyright (c) 2005 Norman Werner ;; All rights reserved.
;; Permission is hereby granted, without written agreement and without ;; license or royalty fees, to use, copy, modify, and distribute this ;; software and its documentation for any purpose, provided that the ;; above copyright notice and the following two paragraphs appear in all ;; copies of this software.
;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE TO ANY PARTY FOR DIRECT, ;; INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF ;; THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR(S), ;; HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;; THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, ;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE ;; PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE AUTHOR(S) HAVE NO ;; OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR ;; MODIFICATIONS.
;;MOTIVATION: ;;When something is specified by its interface we dont want to restrict ;;the unifier to a certain implementation.
;;eg. A tree may be specified by the functions (get-node-value ..) and (get-leafs ...). ;;But a tree maybe implemented as a list, a structure or a clos-bject.
;;Therfore a interface-template is provided which is usefull on its own and ;;which may be used to implement other templates.
;;IMPLEMENTATION: ;;the following implementation tries to imitate the style of ;;the original library. Only little testing was done.
;;this is not rocket-science! (in-package "CL.EXT.DACF.UNIFICATION")
(defclass interface-template (type-template) ())
(defgeneric interface-template-p (x) (:method ((x interface-template)) t) (:method ((x t)) nil))
;;SYNTAX: ;;#T(interface read1 var1 read2 var2 ...) (defmethod make-template ((kind (eql 'interface)) (spec cons)) (declare (ignore kind)) (make-instance 'interface-template :spec (rest spec)))
(defun pairify (list) "groups list into a list of pairs" ;;I don't know how to use loop - so you may want to fix this (cond ((null list) ()) ((= (length list) 1) (error "invalid template-spec")) ( t (cons (list (first list) (second list)) (pairify (cddr list))))))
(defmethod collect-template-vars ((template interface-template)) (mapcan #'(lambda (l) (destructuring-bind (reader var) l (assert (or (symbolp reader) (functionp reader))) (collect-template-vars var))) (pairify (template-spec template))))
;;;I basically copied this from the unifier-method of structure-objects (defmethod unify ((a t) (b interface-template) &optional (env (make-empty-environment))) (if (template-spec b) (loop for (reader value-template) on (template-spec b) by #'cddr ;;FIXME/TODO: do we want to catch errors from (funcall reader a) ?? for mgu = (unify (funcall reader a) value-template env) then (unify (funcall reader a) value-template mgu) finally (return mgu)) env))
(defmethod unify ((b interface-template) (a t) &optional (env (make-empty-environment))) (unify a b))
;;PROBLEMS: ;;(setf e (unify '(1 2 3) #T(interface first ?x))) ;; won't work because ;; other method are more specific:
;;(defmethod unify ((a list) (b template) &optional (env (make-empty-environment))) ;; (declare (ignore env)) ;; (error 'unification-failure ;; :format-control "Cannot unify a list with a non-list template: ~S ~S." ;; :format-arguments (list a b)))
;; this applies of yourse also for other usages.
;; code was tested with the following shortcircuit: ;;(defmethod unify ((a list) (b interface-template) &optional (env (make-empty-environment))) ;; (if (template-spec b) ;; (loop for (reader value-template) on (template-spec b) by #'cddr ;; for mgu = (unify (funcall reader a) value-template env) ;; then (unify (funcall reader a) value-template mgu) ;; finally (return mgu)) ;; env)) ;;
;; Questions / Remarks / BUGS:
;; Examples in the Documentation for matching of structures and objects doesn't work ?! ;; -> Documentation-Bug?
;; Description of Number-template in the doc is incorrect: ;; <quote> ;; The NUMBER-TEMPLATE class denotes those object that are used to unify against a VECTOR. ;; </quote> ?!
;; Is a Facility / Documentation for extending the syntax nessecary (hash-tables, streams, ;; closures there is a plethora of built-ins in CL) ?!
;; You mention in the doc that the license isn't settled yet. ;; I consider this a critical bug.
;; maybe 'match' should be renamed to with-match or something else, to make clear that ;; new bindings are introduced?!
;; The following form: ;; (unify '(foo ?x 42) '(foo baz ?x)) ;; will unify despite your documentation and common ;; practice.
;;This should fix it: (defmethod unify ((a symbol) (b number) &optional (env (make-empty-environment))) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure :format-control "Cannot unify a number ~S with a symbol ~S." :format-arguments (list b a)))))
(defmethod unify ((b number) (a symbol) &optional (env (make-empty-environment))) (unify a b env))
;;(unify '(?x ?x) '("hase" "dodo")) ;; unifies despite common practice.
;; I changed the defmethods ;; (defmethod unify ((a symbol) (b string) &optional (env (make-empty-environment))) ;; (cond ((variable-any-p a) env) ;; ((variablep a) (extend-environment a b env)) ;; (t (error 'unification-failure ;; :format-control "Cannot unify a symbol with a string: ~S ~S." ;; :format-arguments (list a b)))))
;; (defmethod unify ((b string) (a symbol) &optional (env (make-empty-environment))) ;; (cond ((variable-any-p a) env) ;; ((variablep a) (extend-environment a b env)) ;; (t (error 'unification-failure ;; :format-control "Cannot unify a string with a symbol: ~S ~S." ;; :format-arguments (list b a)))))
;;to
(defmethod unify ((a symbol) (b string) &optional (env (make-empty-environment))) (cond ((variable-any-p a) env) ((variablep a) (var-unify a b env)) (t (error 'unification-failure :format-control "Cannot unify symbol with a string: ~S ~S." :format-arguments (list a b)))))
(defmethod unify ((b string) (a symbol) &optional (env (make-empty-environment))) (unify a b env))
Mit WEB.DE FreePhone mit hoechster Qualitaet ab 0 Ct./Min. weltweit telefonieren! http://freephone.web.de/?mc=021201<norman-contributes.lisp>
-- Marco Antoniotti http://bioinformatics.nyu.edu NYU Courant Bioinformatics Group tel. +1 - 212 - 998 3488 715 Broadway 10th FL fax. +1 - 212 - 998 3484 New York, NY, 10003, U.S.A.