summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-24 13:28:45 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-24 13:28:45 +0100
commitaa8645cdf28eb7b13d2813f5f0fe014df4d7b4b8 (patch)
tree7ea1e014c0af0501938d0a377071460016078e19 /Lisp
parent1deb19a20e934084cda4499e6930e35b0d2777c3 (diff)
When receiving a Lisp value wrapper from Objective-C, unwrap it automatically.
darcs-hash:f1b183f46c4d97c27121e0ada8614b9e9feb9955
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/data-types.lisp6
-rw-r--r--Lisp/lisp-value-wrapping.lisp12
-rw-r--r--Lisp/parameters.lisp2
-rw-r--r--Lisp/type-conversion.lisp14
4 files changed, 23 insertions, 11 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index d4e169e..2ab3fe4 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -582,6 +582,12 @@ seems like an acceptable trade-off.
(trivial-garbage:finalize new-wrapper #'finaliser))))))
+(defclass lisp-value-wrapper-mixin ()
+ ((lisp-value :initarg :value
+ :initform nil
+ :accessor lisp-value)))
+
+
(defgeneric objcl-eql (obj1 obj2))
(with-compilation-unit ()
diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp
index dbc9c6e..1406a95 100644
--- a/Lisp/lisp-value-wrapping.lisp
+++ b/Lisp/lisp-value-wrapping.lisp
@@ -26,12 +26,6 @@
(find-objc-class "NSDictionary" t))
-(defclass lisp-value-wrapper-mixin ()
- ((lisp-value :initarg :value
- :initform nil
- :accessor lisp-value)))
-
-
;; May usefully override, among others:
;; - description
(defclass ns::mlk-lisp-value (ns::ns-object lisp-value-wrapper-mixin)
@@ -62,12 +56,14 @@
(defun make-lisp-value (value)
;; FIXME: The following won't work. Make MAKE-INSTANCE more useful...
;(make-instance 'ns::mlk-lisp-value :value value)
- (let ((instance (invoke (typecase value
+ (let* ((*skip-value-wrapper-unwrapping* t)
+ (instance
+ (invoke-by-name (typecase value
(string (find-class 'ns::mlk-lisp-string))
(vector (find-class 'ns::mlk-lisp-array))
(list (find-class 'ns::mlk-lisp-list))
(t (find-class 'ns::mlk-lisp-value)))
- 'new)))
+ "new")))
(setf (lisp-value instance) value)
instance))
diff --git a/Lisp/parameters.lisp b/Lisp/parameters.lisp
index 14a3f16..f6fce2d 100644
--- a/Lisp/parameters.lisp
+++ b/Lisp/parameters.lisp
@@ -26,6 +26,8 @@
(defvar *skip-retaining* nil)
+(defvar *skip-value-wrapper-unwrapping* nil)
+
(defvar *in-make-pointer-wrapper-p* nil
"A debugging tool that helps identify direct MAKE-INSTANCE calls that
ought not be there.")
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index 9796104..5be0f12 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -25,9 +25,17 @@
(typespec-primary-type typespec))
((id objective-c-class exception selector)
(let ((*skip-retaining* skip-retaining-p))
- (intern-pointer-wrapper (typespec-primary-type typespec)
- :pointer (cffi:mem-ref foreign-value-cell
- c-type))))
+ (let ((instance
+ (intern-pointer-wrapper (typespec-primary-type typespec)
+ :pointer (cffi:mem-ref
+ foreign-value-cell
+ c-type))))
+ (typecase instance
+ (lisp-value-wrapper-mixin
+ (if *skip-value-wrapper-unwrapping*
+ instance
+ (lisp-value instance)))
+ (t instance)))))
((:char :unsigned-char)
;; FIXME? This is non-trivial. See policy.lisp for
;; details.