src/method-aggregate.lisp: Store keyword list as a plist on the message.

We'll need some properties in other methods on the message.

diff --git a/src/method-aggregate.lisp b/src/method-aggregate.lisp
index caaa7ea81ab23b071e4815e3e63ed2fd2f342b7d..155ccb7dc04d40459e9ac28b8f5c0650a53f96a0 100644 (file)
--- a/src/method-aggregate.lisp
+++ b/src/method-aggregate.lisp
@@ -33,6 +33,7 @@ (export '(aggregating-message
 (defclass aggregating-message (simple-message)
   ((combination :initarg :combination :type keyword
                :reader sod-message-combination)
 (defclass aggregating-message (simple-message)
   ((combination :initarg :combination :type keyword
                :reader sod-message-combination)

+   (plist :type list :accessor sod-message-plist)

    (kernel-function :type function :reader sod-message-kernel-function))
   (:documentation
    "Message class for aggregating method combinations.
    (kernel-function :type function :reader sod-message-kernel-function))
   (:documentation
    "Message class for aggregating method combinations.


@@ -119,7 +120,7 @@ (defmethod simple-method-body
 (defmethod shared-initialize :before
     ((message aggregating-message) slot-names &key pset)
   (declare (ignore slot-names))
 (defmethod shared-initialize :before
     ((message aggregating-message) slot-names &key pset)
   (declare (ignore slot-names))

-  (with-slots (combination kernel-function) message
+  (with-slots (combination plist kernel-function) message

     (let ((most-specific (get-property pset :most-specific :keyword :first))
          (comb (get-property pset :combination :keyword)))
 
     (let ((most-specific (get-property pset :most-specific :keyword :first))
          (comb (get-property pset :combination :keyword)))
 


@@ -158,6 +159,7 @@ (defmethod shared-initialize :before
                 (prop (get-property pset name type magic)))
            (unless (eq prop magic)
              (setf keys (list* name prop keys)))))
                 (prop (get-property pset name type magic)))
            (unless (eq prop magic)
              (setf keys (list* name prop keys)))))

+       (setf plist keys)

 
        ;; Set the kernel function for later.
        (setf kernel-function
 
        ;; Set the kernel function for later.
        (setf kernel-function


@@ -169,7 +171,7 @@ (defmethod shared-initialize :before
                         (:first methods)
                         (:last (setf methods (reverse methods))))
                       arg-names
                         (:first methods)
                         (:last (setf methods (reverse methods))))
                       arg-names

-                      keys)))))))
+                      plist)))))))

 
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.