;;;--------------------------------------------------------------------------
;;; Classes and protocol.
-(export 'aggregating-message)
+(export '(aggregating-message
+ sod-message-combination sod-message-kernel-function))
(defclass aggregating-message (simple-message)
((combination :initarg :combination :type keyword
- :reader message-combination)
- (kernel-function :type function :reader message-kernel-function))
+ :reader sod-message-combination)
+ (kernel-function :type function :reader sod-message-kernel-function))
(:documentation
"Message class for aggregating method combinations.
(with-slots (combination) message
(check-aggregating-message-type message combination type)))
-(defmethod message-effective-method-class ((message aggregating-message))
+(defmethod sod-message-effective-method-class ((message aggregating-message))
'aggregating-effective-method)
(defmethod simple-method-body
((method aggregating-effective-method) codegen target)
(let ((argument-names (effective-method-basic-argument-names method))
(primary-methods (effective-method-primary-methods method)))
- (funcall (message-kernel-function (effective-method-message method))
+ (funcall (sod-message-kernel-function (effective-method-message method))
codegen target argument-names primary-methods)))
(defmethod shared-initialize :before
:before :fragment
:first :fragment
:each :fragment
- :after :fragment))
+ :after :fragment
+ :count :id))
(defmethod compute-aggregating-message-kernel
((message aggregating-message) (combination (eql :custom))
codegen target methods arg-names
&key (retvar "sod_ret") (valvar "sod_val")
- decls before each (first each) after)
+ decls before each (first each) after count)
(let* ((type (c-type-subtype (sod-message-type message)))
(not-void-p (not (eq type c-type-void))))
(when not-void-p
(ensure-var codegen retvar type)
(ensure-var codegen valvar type))
+ (when count
+ (ensure-var codegen count c-type-int (length methods)))
(when decls
(emit-decl codegen decls))
(labels ((maybe-emit (fragment)