chiark / gitweb /
src/method-aggregate.lisp: Store keyword list as a plist on the message.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 17 Nov 2015 17:20:16 +0000 (17:20 +0000)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 17 Nov 2015 20:34:13 +0000 (20:34 +0000)
We'll need some properties in other methods on the message.

src/method-aggregate.lisp

index caaa7ea81ab23b071e4815e3e63ed2fd2f342b7d..155ccb7dc04d40459e9ac28b8f5c0650a53f96a0 100644 (file)
@@ -33,6 +33,7 @@ (export '(aggregating-message
 (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.
@@ -119,7 +120,7 @@ (defmethod simple-method-body
 (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)))
 
@@ -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)))))
+       (setf plist keys)
 
        ;; 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
-                      keys)))))))
+                      plist)))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.