src/method-aggregate.lisp: New protocol for method return types.

Rather than assume that primary methods should always return the same
type as the message, introduce protocol for the method combination to
decide which return type it wants.

diff --git a/src/method-aggregate.lisp b/src/method-aggregate.lisp
index 155ccb7dc04d40459e9ac28b8f5c0650a53f96a0..37454f862743c3358919b45118f5e08ee2df13fa 100644 (file)
--- a/src/method-aggregate.lisp
+++ b/src/method-aggregate.lisp
@@ -96,6 +96,12 @@ (defgeneric check-aggregating-message-type (message combination type)
   (:method (message combination type)
     t))
 
+(defgeneric aggregating-message-method-return-type (message combination)
+  (:documentation
+   "Return the primary method return type for this MESSAGE and COMBINATION.")
+  (:method ((message aggregating-message) (combination t))
+    (c-type-subtype (sod-message-type message))))
+
 (export 'aggregating-effective-method)
 (defclass aggregating-effective-method (simple-effective-method) ()
   (:documentation "Effective method counterpart to `aggregating-message'."))
@@ -173,6 +179,19 @@ (defmethod shared-initialize :before
                       arg-names
                       plist)))))))
 
+(defmethod check-method-type
+    ((method sod-method) (message aggregating-message)
+     (type c-function-type))
+  (let ((wanted (aggregating-message-method-return-type
+                message (sod-message-combination message)))
+       (msgtype (sod-message-type message)))
+    (unless (c-type-equal-p (c-type-subtype type) wanted)
+      (error "Method return type ~A doesn't match message ~A"
+             (c-type-subtype msgtype) (c-type-subtype type)))
+    (unless (argument-lists-compatible-p (c-function-arguments msgtype)
+                                        (c-function-arguments type))
+      (error "Method arguments ~A don't match message ~A" type msgtype))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.