Support super calls.

darcs-hash:d6b9645fe36711876226cd69bbbc4fce66a94fbb

4 files changed, 47 insertions, 10 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)))