diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/data-types.lisp | 16 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 2 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 34 |
3 files changed, 43 insertions, 9 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index b22057f..35acb2f 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -172,10 +172,10 @@ an __exception__, you can simply send it the `self' message. (defmethod print-object ((object id) stream) (print-unreadable-object (object stream) (format stream "~A `~A' {~X}" - (objcl-class-name (invoke-by-name object "class")) - (invoke-by-name (invoke-by-name object "description") - "UTF8String") - (invoke-by-name object "hash")))) + (objcl-class-name (primitive-invoke object "class" :id)) + (primitive-invoke (primitive-invoke object "description" :id) + "UTF8String" :string) + (primitive-invoke object "hash" :unsigned-int)))) (defmethod print-object ((class objc-class) stream) @@ -183,7 +183,7 @@ an __exception__, you can simply send it the `self' message. (format stream "~S ~A {~X}" 'objc-class (objcl-class-name class) - (invoke-by-name class "hash")))) + (primitive-invoke class "hash" :unsigned-int)))) (defmethod print-object ((selector selector) stream) @@ -197,9 +197,9 @@ an __exception__, you can simply send it the `self' message. (print-unreadable-object (exception stream) (format stream "~S ~A {~X}" 'exception - (invoke-by-name (invoke-by-name exception "name") - "UTF8String") - (invoke-by-name exception "hash")))) + (primitive-invoke (primitive-invoke exception "name" :id) + "UTF8String" :string) + (primitive-invoke exception "hash" :unsigned-int)))) ;;;; (@* "Convenience types") diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index bf80c30..d5d7379 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -290,7 +290,7 @@ by which __invoke__ converts its arguments into a *message name*. '(satisfies cffi:pointerp))) -(declaim (ftype (function ((or selector string list)) selector) +(declaim (ftype (function ((or selector string symbol list)) selector) selector)) (defun selector (designator) "Convert an object into a selector. diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 99ebf7b..5da06b8 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -147,6 +147,40 @@ Returns: *result* --- the return value of the method invocation. (dealloc-objc-arglist objc-arglist))))) +(defmacro primitive-invoke (receiver method-name return-type &rest args) + (let ((real-return-type (if (member return-type '(:id :class :exception)) + :pointer + return-type)) + (real-receiver (gensym)) + (real-selector (gensym)) + (selector (selector method-name))) + `(progn + (let ((,real-receiver ,receiver) + (,real-selector (selector ,method-name))) + (check-type ,real-receiver (or id objc-class exception) + "an Objective C instance (ID, OBJC-CLASS or EXCEPTION)") + (let ((method (get-method-implementation ,real-receiver ,real-selector)) + (objc-arglist (arglist->objc-arglist (list ,@args)))) + (unwind-protect + (let ((return-value + (apply-macro 'foreign-funcall-pointer method + () + (append (list :pointer (pointer-to ,real-receiver)) + (list :pointer (pointer-to ,real-selector)) + objc-arglist + (list ,real-return-type))))) + ,(if (member return-type '(:id :class :exception)) + `(let (,@(when (constructor-name-p (selector-name selector)) + `((*skip-retaining* t)))) + (make-instance ',(case return-type + ((:id) 'id) + ((:class) 'objc-class) + ((:exception) 'exception)) + :pointer return-value)) + `return-value)) + (dealloc-objc-arglist objc-arglist))))))) + + ;;; (@* "Helper functions") (defun arglist->objc-arglist (arglist) (arglist-intersperse-types (mapcar #'lisp->obj-data arglist))) |