(export 'basic-message)
(defclass basic-message (sod-message)
- ((argument-tail :type list :reader sod-message-argument-tail)
- (no-varargs-tail :type list :reader sod-message-no-varargs-tail))
+ ((argument-tail :type list :reader sod-message-argument-tail))
(:documentation
"Base class for built-in message classes.
(argument-type arg))))
(c-function-arguments (sod-message-type message)))))
-(define-on-demand-slot basic-message no-varargs-tail (message)
- (reify-variable-argument-tail (sod-message-argument-tail message)))
-
(defmethod sod-message-method-class
((message basic-message) (class sod-class) pset)
(let ((role (get-property pset :role :keyword nil)))
;;;--------------------------------------------------------------------------
;;; Effective method classes.
+(defmethod method-keyword-argument-lists
+ ((method effective-method) direct-methods)
+ (with-slots (message) method
+ (and (keyword-message-p message)
+ (mapcar (lambda (m)
+ (let ((type (sod-method-type m)))
+ (cons (c-function-keywords type)
+ (format nil "method for ~A on ~A (at ~A)"
+ message
+ (sod-method-class m)
+ (file-location m)))))
+ direct-methods))))
+
(defmethod shared-initialize :after
((method effective-method) slot-names &key direct-methods)
(declare (ignore slot-names))
;; Set the keyword argument list.
(with-slots (message keywords) method
- (setf keywords (and (keyword-message-p message)
- (merge-keyword-lists
- (mapcar (lambda (m)
- (let ((type (sod-method-type m)))
- (cons (c-function-keywords type)
- (format nil "method for ~A on ~A"
- message
- (sod-method-class m)))))
- direct-methods))))))
+ (setf keywords
+ (merge-keyword-lists (method-keyword-argument-lists
+ method direct-methods)))))
(export '(basic-effective-method
effective-method-around-methods effective-method-before-methods
using a slot reader method."))
(define-on-demand-slot basic-effective-method basic-argument-names (method)
- (let ((message (effective-method-message method)))
- (mapcar #'argument-name
- (sod-message-no-varargs-tail message))))
+ (let* ((message (effective-method-message method))
+ (raw-tail (sod-message-argument-tail message)))
+ (mapcar #'argument-name (reify-variable-argument-tail raw-tail))))
(defmethod effective-method-function-name ((method effective-method))
(let* ((class (effective-method-class method))
(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)))
(call-next-method)))))))
-(defmethod compute-method-entry-functions
- ((method simple-effective-method))
- (if (effective-method-primary-methods method)
+(defmethod effective-method-live-p ((method simple-effective-method))
+ (effective-method-primary-methods method))
+
+(defmethod compute-method-entry-functions :around ((method effective-method))
+ (if (effective-method-live-p method)
(call-next-method)
nil))