The code used to just assume that receiver (`me') arguments had type
`CLASS *'. This is about to change...
sod-message-check-methods generic
sod-message-effective-method-class generic
sod-message-keyword-argument-lists generic
sod-message-check-methods generic
sod-message-effective-method-class generic
sod-message-keyword-argument-lists generic
+ sod-message-receiver-type generic
sod-method-description generic
sod-method-function-name generic
sod-method-function-type generic
sod-method-description generic
sod-method-function-name generic
sod-method-function-type generic
sod-message sod-class t
sod-message-name
sod-message
sod-message sod-class t
sod-message-name
sod-message
+sod-message-receiver-type
+ sod-message sod-class
sod-message-type
sod-message
sod-method-body
sod-message-type
sod-message
sod-method-body
\end{describe*}
\begin{describe}{gf}
\end{describe*}
\begin{describe}{gf}
+ {sod-message-receiver-type @<message> @<class> @> @<c-type>}
+\end{describe}
+
+\begin{describe}{gf}
{sod-message-applicable-methods @<message> @<class> @> list}
\end{describe}
{sod-message-applicable-methods @<message> @<class> @> list}
\end{describe}
((nil) (error "How odd: a primary method slipped through the net"))
(t (error "Unknown method role ~A" role)))))
((nil) (error "How odd: a primary method slipped through the net"))
(t (error "Unknown method role ~A" role)))))
+(defmethod sod-message-receiver-type ((message sod-message)
+ (class sod-class))
+ (c-type (* (class class))))
+
(export 'simple-message)
(defclass simple-message (basic-message)
()
(export 'simple-message)
(defclass simple-message (basic-message)
()
(when (keyword-message-p message)
(setf method-args (fix-up-keyword-method-args method method-args)))
(c-type (fun (lisp (c-type-subtype type))
(when (keyword-message-p message)
(setf method-args (fix-up-keyword-method-args method method-args)))
(c-type (fun (lisp (c-type-subtype type))
- ("me" (* (class (sod-method-class method))))
+ ("me" (lisp (sod-message-receiver-type
+ message (sod-method-class method))))
. method-args))))
(defmethod sod-method-description ((method basic-direct-method))
. method-args))))
(defmethod sod-method-description ((method basic-direct-method))
(t
msgargs))))
(c-type (fun (lisp return-type)
(t
msgargs))))
(c-type (fun (lisp return-type)
- ("me" (* (class (sod-method-class method))))
+ ("me" (lisp (sod-message-receiver-type
+ message (sod-method-class method))))
. arguments))))
(define-on-demand-slot delegating-direct-method function-type (method)
. arguments))))
(define-on-demand-slot delegating-direct-method function-type (method)
(t
(push next-method-arg method-args)))
(c-type (fun (lisp (c-type-subtype type))
(t
(push next-method-arg method-args)))
(c-type (fun (lisp (c-type-subtype type))
- ("me" (* (class (sod-method-class method))))
+ ("me" (lisp (sod-message-receiver-type
+ message (sod-method-class method))))
. method-args))))
;;;--------------------------------------------------------------------------
. method-args))))
;;;--------------------------------------------------------------------------
((nil) raw-tail)
(:valist (reify-variable-argument-tail raw-tail)))))
(c-type (fun (lisp (c-type-subtype type))
((nil) raw-tail)
(:valist (reify-variable-argument-tail raw-tail)))))
(c-type (fun (lisp (c-type-subtype type))
- ("me" (* (class (method-entry-chain-tail entry))))
+ ("me" (lisp (sod-message-receiver-type
+ message (method-entry-chain-tail entry))))
. tail))))
(defgeneric effective-method-keyword-parser-function-name (method)
. tail))))
(defgeneric effective-method-keyword-parser-function-name (method)
(deliver-call codegen :void "SOD__IGNORE" "sod__obj")))
(finish-entry (tail)
(let* ((head (sod-class-chain-head tail))
(deliver-call codegen :void "SOD__IGNORE" "sod__obj")))
(finish-entry (tail)
(let* ((head (sod-class-chain-head tail))
+ (my-type (sod-message-receiver-type message tail))
(role (if parm-n :valist nil))
(name (method-entry-function-name method head role))
(type (c-type (fun (lisp return-type)
(role (if parm-n :valist nil))
(name (method-entry-function-name method head role))
(type (c-type (fun (lisp return-type)
- ("me" (* (class tail)))
. entry-args))))
(codegen-pop-function codegen name type
"~@(~@[~A ~]entry~) function ~:_~
. entry-args))))
(codegen-pop-function codegen name type
"~@(~@[~A ~]entry~) function ~:_~
(mapcar #'argument-name entry-args)))
(main (method-entry-function-name method head nil))
(main-type (c-type (fun (lisp return-type)
(mapcar #'argument-name entry-args)))
(main (method-entry-function-name method head nil))
(main-type (c-type (fun (lisp return-type)
- ("me" (* (class tail)))
. raw-entry-args))))
(codegen-push codegen)
(ensure-var codegen *sod-ap* c-type-va-list)
. raw-entry-args))))
(codegen-push codegen)
(ensure-var codegen *sod-ap* c-type-va-list)
will be a list of applicable methods sorted in most-to-least specific
order."))
will be a list of applicable methods sorted in most-to-least specific
order."))
+(export 'sod-message-receiver-type)
+(defgeneric sod-message-receiver-type (message class)
+ (:documentation
+ "Return the type of the `me' argument in a MESSAGE received by CLASS.
+
+ Typically this will just be `CLASS *'."))
+
(export 'sod-message-applicable-methods)
(defgeneric sod-message-applicable-methods (message class)
(:documentation
(export 'sod-message-applicable-methods)
(defgeneric sod-message-applicable-methods (message class)
(:documentation