diff options
| -rw-r--r-- | Lisp/defpackage.lisp | 1 | ||||
| -rw-r--r-- | Lisp/method-definition.lisp | 41 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 11 | ||||
| -rw-r--r-- | Lisp/name-conversion.lisp | 4 | ||||
| -rw-r--r-- | objective-cl.asd | 4 |
5 files changed, 49 insertions, 12 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index c14fca9..074e8ab 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -40,6 +40,7 @@ #:undefine-returns-boolean-exception #:collect-classes #:collect-methods + #:super ;; Generic functions #:objc-eql diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp index edba760..b83570e 100644 --- a/Lisp/method-definition.lisp +++ b/Lisp/method-definition.lisp @@ -78,9 +78,13 @@ undefined.")) *name* --- a *symbol*. -*lambda-list* --- a **generic function lambda list**. +*qualifier* --- a **method qualifier**. -*options* --- a *list* (not evaluated). +*return-type* --- a *typespec*. + +*lambda-list* --- a **modified lambda list**. + +*body* --- an **implicit progn**. ## Description: @@ -100,6 +104,9 @@ following aspects: _define-objective-c-generic-function_ recognises the same *options* as __defgeneric__, including _:generic-function-class_ and _:method-class_. +The **lexical environment** of *body* is augmented to include the +function __super__. + ## Example: @@ -160,7 +167,8 @@ __define-objective-c-generic-function__. ## See also: - __define-objective-c-generic-function__, __define-objective-c-class__" + __define-objective-c-generic-function__, __define-objective-c-class__, +__super__" (let ((qualifiers (list))) (loop until (listp (first args)) do (push (pop args) qualifiers)) @@ -173,6 +181,7 @@ __define-objective-c-generic-function__. if (listp arg) if (typep (second arg) 'objective-c-type-keyword) collect (second arg) into type-specifiers + and collect (first arg) into arg-names and do (setf (car arg-cons) (first arg)) else ;; We simply map all non-OBJECTIVE-C-TYPE-KEYWORD @@ -184,14 +193,28 @@ __define-objective-c-generic-function__. ;; kind to the method, whose type specifier is :ID as ;; well. collect :id into type-specifiers + and collect (first arg) into arg-names else collect :id into type-specifiers - finally (return - `(defmethod ,(intern (symbol-name name) - '#:objective-c-methods) - argtypes-start ,@type-specifiers argtypes-end - ,@qualifiers ,lambda-list - ,@body))))))) + and collect arg into arg-names + finally (let ((super-args-sym (gensym)) + (super-real-args-sym (gensym))) + (return + `(defmethod ,(intern (symbol-name name) + '#:objective-c-methods) + argtypes-start ,@type-specifiers argtypes-end + ,@qualifiers ,lambda-list + (flet ((super (&rest ,super-args-sym) + (let ((,super-real-args-sym + (or ,super-args-sym + (list ,@(rest arg-names))))) + (invoke-by-name-super-v + ,(first arg-names) + ,(generic-function-name->method-name + name) + (find-objc-class ',(cadar lambda-list)) + ,super-real-args-sym)))) + ,@body))))))))) (defmacro defobjcgeneric (name lambda-list &body options) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 8f1c9c0..ab520df 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -207,6 +207,11 @@ easier to use with __apply__. __invoke__" + (invoke-by-name-super-v receiver method-name nil args)) + + +(defun invoke-by-name-super-v (receiver method-name superclass-for-send-super + args) ;; TODO: Support varargs. (let* ((selector (if (typep method-name 'selector) method-name @@ -227,7 +232,11 @@ easier to use with __apply__. argc (+ 2 (length args))) (low-level-invoke receiver selector - (null-pointer) + (if (and superclass-for-send-super + (not (and (pointerp superclass-for-send-super) + (null-pointer-p superclass-for-send-super)))) + (pointer-to superclass-for-send-super) + (null-pointer)) method-return-typestring method-return-type method-arg-typestrings diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp index 1596d84..028d722 100644 --- a/Lisp/name-conversion.lisp +++ b/Lisp/name-conversion.lisp @@ -35,6 +35,10 @@ :initial-value "")) +(defun generic-function-name->method-name (gf-name) + (symbol-name gf-name)) + + (defun generic-function-name->selector (gf-name) (selector (symbol-name gf-name))) diff --git a/objective-cl.asd b/objective-cl.asd index aebcad6..e28e90a 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -85,7 +85,8 @@ "libobjcl" "type-conversion" "type-handling" - "data-types")) + "data-types" + "method-definition")) (:file "instance-management" :depends-on ("defpackage" "libobjcl" "init" @@ -96,7 +97,6 @@ (:file "method-definition" :depends-on ("defpackage" "libobjcl" "init" - "class-definition" "method-invocation" "data-types")) (:file "lisp-value-wrapping" :depends-on ("defpackage" |