summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-06 22:52:59 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-06 22:52:59 +0100
commit230184a4f786ee656871fe30abc20033c669b90d (patch)
treecc0f66125436de4cd753292a10314f4e7a1d7e0d
parentf9c6f26037c09495bd6c5791c85717b013a4492f (diff)
Make OBJECTIVE-C-METHODs dispatch on the class they have been defined for.
darcs-hash:93ae22beaabb2a9f162a297a8c314d36e882a4ab
-rw-r--r--Lisp/method-definition.lisp19
1 files changed, 14 insertions, 5 deletions
diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp
index 7218f48..741c6ca 100644
--- a/Lisp/method-definition.lisp
+++ b/Lisp/method-definition.lisp
@@ -207,12 +207,16 @@ __super__"
collect :id into type-specifiers
and collect arg into arg-names
finally (let ((super-args-sym (gensym))
- (captured-args-sym (gensym)))
+ (captured-args-sym (gensym))
+ (class-arg-sym (gensym))
+ (class-name (class-name (find-objc-class
+ (cadar lambda-list)))))
(return
`(defmethod ,(intern (symbol-name name)
'#:objective-c-methods)
argtypes-start ,@type-specifiers argtypes-end
- ,@qualifiers ,lambda-list
+ ,@qualifiers ((,class-arg-sym (eql ',class-name))
+ ,@lambda-list)
(let ((,captured-args-sym (list ,@arg-names)))
(flet ((super (&rest ,super-args-sym)
(invoke-by-name-super-v
@@ -220,7 +224,7 @@ __super__"
,(generic-function-name->method-name
name)
(objcl-class-superclass
- (find-objc-class ',(cadar lambda-list)))
+ (find-objc-class ',class-name))
(or ,super-args-sym
(rest ,captured-args-sym)))))
(declare (ignorable (function super)))
@@ -340,7 +344,7 @@ __define-objective-c-generic-function__.
__define-objective-c-method__, __define-objective-c-class__"
`(defgeneric ,(intern (symbol-name name) '#:objective-c-methods)
- ,lambda-list
+ (,(gensym "CLASS") ,@lambda-list)
,@(unless (position :generic-function-class
options
:key #'car)
@@ -369,7 +373,7 @@ __define-objective-c-generic-function__.
(defmethod add-method :after ((gf objective-c-generic-function)
(method objective-c-method))
;; FIXME: Support &REST arguments.
- (let* ((class (first (method-specializers method)))
+ (let* ((class (second (method-specializers method)))
(method-name (generic-function-name->selector
(generic-function-name gf)))
(registered-p (foreign-class-registered-p class))
@@ -406,6 +410,11 @@ __define-objective-c-generic-function__.
(unwind-protect
(coerce-object
(,(generic-function-name gf)
+ ;; Pass the class this method is
+ ;; being defined for as the first
+ ;; argument. This is needed so that
+ ;; super calls can work.
+ ',(class-name class)
;; Leave the second argument (the
;; selector) out.
,@(list* (car arguments) (cddr arguments)))