Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv21893/src/elephant Modified Files: package.lisp serializer2.lisp Added Files: pset.lisp Log Message: Trial pset abstraction; fix for debug serialize of complex and more documentation edits --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/01 20:56:19 1.28 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/06 02:51:48 1.29 @@ -206,6 +206,8 @@ #:persistent #:persistent-object #:persistent-metaclass #:defpclass #:persistent-collection #:drop-pobject + #:pset #:make-pset #:insert-item #:remove-item #:map-pset #:find-item #:pset-list + #:btree #:make-btree #:get-value #:remove-kv #:existsp #:indexed-btree #:make-indexed-btree --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/04/04 15:28:29 1.36 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/04/06 02:51:48 1.37 @@ -368,7 +368,8 @@ (,+object+ . "standard object") (,+array+ . "array") (,+struct+ . "struct") - (,+class+ . "class"))) + (,+class+ . "class") + (,+complex+ . "complex"))) (defun enable-deserializer-tracing () (setf *trace-deserializer* t)) --- /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/04/06 02:51:48 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/04/06 02:51:48 1.1 (in-package :elephant) ;; ;; Simple implementation of persistent sets ;; ;; ;; Public API ;; (defclass pset (persistent-collection) () (:documentation "An unordered persistent collection of unique elements according to serializer equal comparison")) (defgeneric insert-item (item pset) (:documentation "Insert a new item into the pset")) (defgeneric remove-item (item pset) (:documentation "Remove specified item from pset")) (defgeneric map-pset (fn pset) (:documentation "Map operator for psets")) (defgeneric find-item (item pset &key key test) (:documentation "Find a an item in the pset using key and test")) (defgeneric pset-list (pset) (:documentation "Convert items of pset into a list for processing")) (defgeneric build-pset (sc) (:documentation "Construct an empty default pset or backend specific pset. This is an internal function used by make-pset")) ;; NOTE: Other operators? ;; - Efficient union, intersection and difference fn's exploiting an underlying ;; sorted order? ;; - map delete operator? ;; ;; Default implementation based on btrees ;; (defclass default-pset (pset) ((btree :accessor pset-btree :initarg :btree))) (defmethod build-pset ((sc store-controller)) "Default pset method; override if backend has better policy" (let ((btree (make-btree sc))) (make-instance 'default-pset :btree btree :sc sc :from-oid (oid btree)))) (defun make-pset (&key items pset (sc *store-controller*)) (let ((new-pset (build-pset sc))) (when (and items pset) (error "Can only initialize a new pset with item list or pset to copy, not both")) (when items (mapc (lambda (item) (insert-item item new-pset)) items)) (when pset (map-pset (lambda (item) (insert-item item new-pset)) pset)) new-pset)) (defmethod insert-item (item (pset default-pset)) (setf (get-value item (pset-btree pset)) t) item) (defmethod remove-item (item (pset default-pset)) (remove-kv item (pset-btree pset)) item) (defmethod find-item (item (pset default-pset) &key key (test #'equal)) (if (not (or key test)) (get-value item (pset-btree pset)) (map-btree (lambda (elt dc) (declare (ignore dc)) (let ((cmpval (if key (funcall key elt) elt))) (if (funcall test item cmpval) (return-from find-item elt)))) (pset-btree pset)))) (defmethod map-pset (fn (pset default-pset)) (map-btree fn (pset-btree pset)) pset) (defmethod pset-list ((pset default-pset)) (let ((list nil)) (flet ((collect (item) (push item list))) (declare (dynamic-extent collect)) (map-btree (lambda (item dc) (declare (ignore dc)) (push item list)) (pset-btree pset))) list))