Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv20086/src/elephant
Modified Files: controller.lisp serializer.lisp Log Message: Fix SBCL struct serialization; cleanup TODO after Trac conversion; remove persistant aggregate stubs
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/24 14:51:59 1.37 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/25 09:12:47 1.38 @@ -492,54 +492,6 @@ (when entry (cdr entry))))
-;; -;; Callback hooks for persistent variables -;; - -;; Design sketch; not sure I'll promote this. -;; To be looked at again for 0.6.2 or 0.7.0 - -;;(defvar *variable-hooks* nil -;; "An alist (specs -> varlist) where varlist is tuple of -;; lisp name, store name (auto) and policy") - -;;(defun add-hook (name spec) -;; (if (assoc spec *variable-hooks* :test #'equal) -;; (push name (assoc spec *variable-hooks* :test #'equal)) -;; (push (cons spec (list name)) *variable-hooks*))) - -;;(defun remove-hook (name spec) -;; (if (assoc spec *variable-hooks* :test #'equal) -;; (setf (assoc spec *variable-hooks* :test #'equal) -;; (remove name (assoc spec *variable-hooks* :test #'equal))) -;; (error "No hooks declared on ~A" spec))) - -;; (defmacro defpvar (name spec (policy &rest accessors) initial-value &optional (documentation nil)) -;; `(progn -;; (defvar ,name ,initial-value ,documentation) -;; (add-hook ,name ,spec) -;; ,(case policy -;; (:wrap-mutators -;; `(progn -;; ,(loop for accessor in accessors do -;; (let ((gf (ensure-generic-function -;; `(defmethod ,accessor :after ( - -;; (defpvar *agencies* (:wrap-mutators -;; 'add-agent -;; 'remove-agent -;; 'clear-agents) -;; nil -;; "test") - -;; (defmethod add-agent (agent) -;; (push agent *agencies*)) - -;; (defmethod remove-agent (agent) -;; (setf *agencies* (remove agent *agencies*))) - -;; (defmethod clear-agents (agent) -;; (setf *agencies* nil))
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/25 03:37:37 1.22 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/25 09:12:47 1.23 @@ -198,16 +198,14 @@ "List of slot names followed by values for structure object" (let ((result nil) (slots - #+openmcl + #+(or sbcl cmu allegro) + (mapcar #'slot-definition-name (class-slots (class-of object))) + #+openmcl (let* ((sd (gethash (class-name (class-of object)) ccl::%defstructs%)) (slots (if sd (ccl::sd-slots sd)))) (mapcar #'car (if (symbolp (caar slots)) slots (cdr slots)))) - #+cmu - (mapcar #'pcl:slot-definition-name (pcl:class-slots (class-of object))) #+lispworks - (structure:structure-class-slot-names (class-of object)) - #+allegro - (mapcar #'mop:slot-definition-name (mop:class-slots (class-of object))))) + (structure:structure-class-slot-names (class-of object)))) (loop for slot in slots do (push (slot-value object slot) result) (push slot result))