summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-09-21 01:11:47 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-09-21 01:11:47 +0200
commitdccb7b26e4999d0c0c6a44cc1cae585bfdd92863 (patch)
tree0511a816f15b3a6bf1e1028fe6f3d95529333df4 /Lisp
parent6da9b0259a0659c1a5bf6e7bd8035972a29f5742 (diff)
Rip the old INVOKE-BY-NAME code out and replace it with INVOKE-WITH-CONVERSION.
darcs-hash:387f803fd82310a0b84948e46c6d0c0619c54ab7
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/method-invocation.lisp89
1 files changed, 29 insertions, 60 deletions
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index d55d200..a2a21f2 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -80,7 +80,7 @@ if as the second **argument** to __invoke-by-name__.
((null (cddr components-left))
(apply #'invoke-by-name
receiver
- (symbol-list->message-name (nreverse message-list))
+ (nreverse message-list)
(nreverse arglist)))))
@@ -119,32 +119,30 @@ Returns: *result* --- the return value of the method invocation.
__invoke__"
- (check-type receiver (or id objc-class exception)
- "an Objective C instance (ID, OBJC-CLASS or EXCEPTION)")
- (when *trace-method-calls*
- (format t "~&Invoking [~A].~%" method-name))
- (flet ((convert/signal (foreign-value)
- ;; Convert a foreign value into a Lisp value. If the value
- ;; to be converted represents an exception, signal it instead
- ;; of returning it as a value.
- (let ((lisp-value (obj-data->lisp foreign-value)))
- (if (typep lisp-value 'condition)
- (cerror "Return NIL from OBJCL-INVOKE-METHOD." lisp-value)
- lisp-value))))
- (let ((objc-arglist (arglist->objc-arglist args))
- (selector (selector method-name)))
- (unwind-protect
- (with-foreign-conversion ((objc-receiver receiver))
- (with-obj-data-values ((return-value
- (apply-macro '%objcl-invoke-method
- objc-receiver
- (pointer-to selector)
- (length args)
- objc-arglist)))
- (let ((*skip-retaining* (or *skip-retaining*
- (constructor-name-p method-name))))
- (convert/signal return-value))))
- (dealloc-objc-arglist objc-arglist)))))
+ ;; TODO: Support varargs.
+ (let* ((selector (selector method-name))
+ (class (object-get-class receiver)))
+ (multiple-value-bind (argc
+ method-return-typestring
+ method-return-type
+ method-arg-typestrings
+ method-arg-types)
+ (retrieve-method-signature-info class selector
+ (if (object-is-class-p receiver)
+ :class
+ :instance))
+ (assert (= argc (+ 2 (length args)))
+ (args)
+ "Wrong number of arguments (expected ~A, got ~A)."
+ argc (+ 2 (length args)))
+ (low-level-invoke receiver
+ selector
+ method-return-typestring
+ method-return-type
+ method-arg-typestrings
+ method-arg-types
+ argc
+ args))))
(defmacro unsafe-primitive-invoke (receiver method-name return-type &rest args)
@@ -423,33 +421,6 @@ Returns: *result* --- the return value of the method invocation.
return-c-type)))))))))
-(defun invoke-with-conversion (receiver method-name &rest args)
- ;; TODO: Support varargs.
- (let* ((selector (selector method-name))
- (class (object-get-class receiver)))
- (multiple-value-bind (argc
- method-return-typestring
- method-return-type
- method-arg-typestrings
- method-arg-types)
- (retrieve-method-signature-info class selector
- (if (object-is-class-p receiver)
- :class
- :instance))
- (assert (= argc (+ 2 (length args)))
- (args)
- "Wrong number of arguments (expected ~A, got ~A)."
- argc (+ 2 (length args)))
- (low-level-invoke receiver
- selector
- method-return-typestring
- method-return-type
- method-arg-typestrings
- method-arg-types
- argc
- args))))
-
-
;; Optimise constant method names away by converting them to selectors
;; at load-time.
(define-compiler-macro primitive-invoke (&whole form
@@ -475,15 +446,13 @@ Returns: *result* --- the return value of the method invocation.
form))
-;; Do the same optimisations for INVOKE-WITH-CONVERSION as for
-;; PRIMITIVE-INVOKE.
-(define-compiler-macro invoke-with-conversion (&whole form
- receiver method-name
- &rest args)
+;; Do the same optimisations for INVOKE-BY-NAME as for PRIMITIVE-INVOKE.
+(define-compiler-macro invoke-by-name (&whole form
+ receiver method-name &rest args)
(if (and (constantp method-name)
(not (and (listp method-name)
(eq 'load-time-value (car method-name)))))
- `(invoke-with-conversion
+ `(invoke-by-name
,receiver
(load-time-value (handler-case
(selector ,method-name)