;;;--------------------------------------------------------------------------
;;; Effective method classes.
-(defmethod method-keyword-argument-lists
- ((method effective-method) direct-methods state)
- (with-slots (message) method
- (and (keyword-message-p message)
- (cons (cons (lambda (arg)
- (let ((class (sod-message-class message)))
- (info-with-location
- message "Type `~A' declared in message ~
- definition in `~A' (here)"
- (argument-type arg) class)
- (report-inheritance-path state class)))
- (c-function-keywords (sod-message-type message)))
- (mapcar (lambda (m)
- (cons (lambda (arg)
- (let ((class (sod-method-class m)))
- (info-with-location
- m "Type `~A' declared in ~A direct ~
- method of `~A' (defined here)"
- (argument-type arg)
- (sod-method-description m) class)
- (report-inheritance-path state class)))
- (c-function-keywords (sod-method-type m))))
- direct-methods)))))
+(defmethod sod-message-keyword-argument-lists
+ ((message sod-message) (class sod-class) direct-methods state)
+ (and (keyword-message-p message)
+ (cons (cons (lambda (arg)
+ (let ((class (sod-message-class message)))
+ (info-with-location
+ message "Type `~A' declared in message ~
+ definition in `~A' (here)"
+ (argument-type arg) class)
+ (report-inheritance-path state class)))
+ (c-function-keywords (sod-message-type message)))
+ (mapcar (lambda (method)
+ (cons (lambda (arg)
+ (let ((class (sod-method-class method)))
+ (info-with-location
+ method "Type `~A' declared in ~A direct ~
+ method of `~A' (defined here)"
+ (argument-type arg)
+ (sod-method-description method) class)
+ (report-inheritance-path state class)))
+ (c-function-keywords (sod-method-type method))))
+ direct-methods))))
+
+(defmethod sod-message-check-methods
+ ((message sod-message) (class sod-class) direct-methods)
+ (compute-effective-method-keyword-arguments message class direct-methods))
(defmethod shared-initialize :after
((method effective-method) slot-names &key direct-methods)
;; class construction.
(with-slots ((class %class) message keywords) method
(setf keywords
- (merge-keyword-lists
- (lambda ()
- (values class
- (format nil
- "methods for message `~A' ~
- applicable to class `~A'"
- message class)))
- (method-keyword-argument-lists method direct-methods
- (make-inheritance-path-reporter-state class))))))
+ (compute-effective-method-keyword-arguments message
+ class
+ direct-methods))))
(export '(basic-effective-method
effective-method-around-methods effective-method-before-methods
(codegen-push codegen)
(ensure-var codegen "sod__obj" ilayout-type
(make-convert-to-ilayout-inst class
- head "me"))))
+ head "me"))
+ (deliver-call codegen :void "SOD__IGNORE" "sod__obj")))
(finish-entry (tail)
(let* ((head (sod-class-chain-head tail))
(role (if parm-n :valist nil))
(*keyword-struct-disposition* :local))
(ensure-var codegen *sod-keywords* (c-type (struct tag)))
(make-keyword-parser-function codegen method tag set keywords)
+ (emit-insts codegen
+ (mapcar (lambda (keyword)
+ (make-set-inst
+ (format nil "~A.~A__suppliedp"
+ *sod-keywords*
+ (argument-name keyword))
+ 0))
+ keywords))
(parse-keywords (lambda ()
(call :void name kw-addr ap-addr
*null-pointer* 0)))